-- {-# 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

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

targetDescXhair :: MonadClientUI m
                => m (Maybe Text, Maybe Text, 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
  (mhairDesc :: Maybe Text
mhairDesc, mxhairHP :: Maybe Text
mxhairHP) <- Maybe Target -> m (Maybe Text, Maybe Text)
forall (m :: * -> *).
MonadClientUI m =>
Maybe Target -> m (Maybe Text, Maybe Text)
targetDesc Maybe Target
sxhair
  let maid :: Maybe ActorId
maid = case Maybe Target
sxhair of
        Just (TEnemy a :: ActorId
a) -> ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
a
        Just (TNonEnemy a :: ActorId
a) -> ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
a
        _ -> Maybe ActorId
forall a. Maybe a
Nothing
  case Maybe ActorId
maid of
    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 aid :: 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 drawnLevelId :: LevelId
drawnLevelId = do
  COps{corule :: COps -> RuleContent
corule=RuleContent{Int
rXmax :: RuleContent -> Int
rXmax :: Int
rXmax}, ContentData TileKind
cotile :: COps -> ContentData TileKind
cotile :: ContentData TileKind
cotile, TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  StateClient{Int
smarkSuspect :: StateClient -> Int
smarkSuspect :: Int
smarkSuspect} <- m StateClient
forall (m :: * -> *). MonadClientRead m => m StateClient
getClient
  -- Not @ScreenContent@, because indexing in level's data.
  Level{ltile :: Level -> TileMap
ltile=PointArray.Array{Vector (UnboxRep (ContentId TileKind))
avector :: forall c. Array c -> Vector (UnboxRep c)
avector :: Vector (UnboxRep (ContentId TileKind))
avector}, ItemFloor
lembed :: Level -> ItemFloor
lembed :: ItemFloor
lembed} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
drawnLevelId
  EnumSet Point
totVisible <- Perception -> EnumSet Point
totalVisible (Perception -> EnumSet Point) -> m Perception -> m (EnumSet Point)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LevelId -> m Perception
forall (m :: * -> *). MonadClientRead m => LevelId -> m Perception
getPerFid LevelId
drawnLevelId
  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 pI :: Int
pI tile :: ContentId TileKind
tile =
        let TK.TileKind{Char
tsymbol :: TileKind -> Char
tsymbol :: Char
tsymbol, Color
tcolor :: TileKind -> Color
tcolor :: Color
tcolor, Color
tcolor2 :: TileKind -> Color
tcolor2 :: Color
tcolor2} = ContentData TileKind -> ContentId TileKind -> TileKind
forall a. ContentData a -> ContentId a -> a
okind ContentData TileKind
cotile ContentId TileKind
tile
            -- @smarkSuspect@ can be turned off easily, so let's overlay it
            -- over both visible and remembered tiles.
            fg :: Color.Color
            fg :: Color
fg | Int
smarkSuspect Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
                 Bool -> Bool -> Bool
&& TileSpeedup -> ContentId TileKind -> Bool
Tile.isSuspect TileSpeedup
coTileSpeedup ContentId TileKind
tile = Color
Color.BrMagenta
               | Int
smarkSuspect Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1
                 Bool -> Bool -> Bool
&& TileSpeedup -> ContentId TileKind -> Bool
Tile.isHideAs TileSpeedup
coTileSpeedup ContentId TileKind
tile = Color
Color.Magenta
               | -- Converting maps is cheaper than converting points
                 -- and this function is a bottleneck, so we hack a bit.
                 Int
pI Int -> IntSet -> Bool
`IS.member` EnumSet Point -> IntSet
forall k. EnumSet k -> IntSet
ES.enumSetToIntSet EnumSet Point
totVisible
                 -- If all embeds spent, mark it with darker colour.
                 Bool -> Bool -> Bool
&& Bool -> Bool
not (TileSpeedup -> ContentId TileKind -> Bool
Tile.isEmbed TileSpeedup
coTileSpeedup ContentId TileKind
tile
                         Bool -> Bool -> Bool
&& Int
pI Int -> IntMap ItemBag -> Bool
forall a. Int -> IntMap a -> Bool
`IM.notMember`
                              ItemFloor -> IntMap ItemBag
forall k a. EnumMap k a -> IntMap a
EM.enumMapToIntMap ItemFloor
lembed) = Color
tcolor
               | Bool
otherwise = Color
tcolor2
        in Color -> Char -> AttrCharW32
Color.attrChar2ToW32 Color
fg Char
tsymbol
      g :: PointI -> Word16 -> Word32
      g :: Int -> Word16 -> Word32
g !Int
pI !Word16
tile = AttrCharW32 -> Word32
Color.attrCharW32 (AttrCharW32 -> Word32) -> AttrCharW32 -> Word32
forall a b. (a -> b) -> a -> b
$ Int -> ContentId TileKind -> AttrCharW32
dis Int
pI (Word16 -> ContentId TileKind
forall c. Word16 -> ContentId c
toContentId Word16
tile)
      caveVector :: U.Vector Word32
      caveVector :: Vector Word32
caveVector = (Int -> Word16 -> Word32) -> Vector Word16 -> Vector Word32
forall a b.
(Unbox a, Unbox b) =>
(Int -> a -> b) -> Vector a -> Vector b
U.imap Int -> Word16 -> Word32
g Vector Word16
Vector (UnboxRep (ContentId TileKind))
avector
      messageVector :: Vector Word32
messageVector =
        Int -> Word32 -> Vector Word32
forall a. Unbox a => Int -> a -> Vector a
U.replicate Int
rXmax (AttrCharW32 -> Word32
Color.attrCharW32 AttrCharW32
Color.spaceAttrW32)
      statusVector :: Vector Word32
statusVector = Int -> [Word32] -> Vector Word32
forall a. Unbox a => Int -> [a] -> Vector a
U.fromListN (2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
rXmax) ([Word32] -> Vector Word32) -> [Word32] -> Vector Word32
forall a b. (a -> b) -> a -> b
$ (AttrCharW32 -> Word32) -> 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 drawnLevelId :: LevelId
drawnLevelId = do
  COps{corule :: COps -> RuleContent
corule=RuleContent{Int
rXmax :: Int
rXmax :: RuleContent -> Int
rXmax}} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  SessionUI{Bool
smarkSmell :: SessionUI -> Bool
smarkSmell :: Bool
smarkSmell} <- m SessionUI
forall (m :: * -> *). MonadClientUI m => m SessionUI
getSession
  -- Not @ScreenContent@, because indexing in level's data.
  Level{SmellMap
lsmell :: Level -> SmellMap
lsmell :: SmellMap
lsmell, Time
ltime :: Level -> Time
ltime :: Time
ltime, ItemFloor
lfloor :: Level -> ItemFloor
lfloor :: ItemFloor
lfloor} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
drawnLevelId
  ItemId -> ItemFull
itemToF <- (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull))
-> (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ItemFull) -> State -> ItemId -> ItemFull
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemFull
itemToFull
  let {-# INLINE viewItemBag #-}
      viewItemBag :: Int -> ItemBag -> AttrCharW32
viewItemBag _ floorBag :: ItemBag
floorBag = case ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.toDescList ItemBag
floorBag of
        (iid :: ItemId
iid, _kit :: ItemQuant
_kit) : _ -> ItemFull -> AttrCharW32
viewItem (ItemFull -> AttrCharW32) -> ItemFull -> AttrCharW32
forall a b. (a -> b) -> a -> b
$ ItemId -> ItemFull
itemToF ItemId
iid
        [] -> [Char] -> AttrCharW32
forall a. HasCallStack => [Char] -> a
error ([Char] -> AttrCharW32) -> [Char] -> AttrCharW32
forall a b. (a -> b) -> a -> b
$ "lfloor not sparse" [Char] -> () -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` ()
      viewSmell :: PointI -> Time -> Color.AttrCharW32
      {-# INLINE viewSmell #-}
      viewSmell :: Int -> Time -> AttrCharW32
viewSmell pI :: Int
pI sml :: Time
sml =
        let fg :: Color
fg = Int -> Color
forall a. Enum a => Int -> a
toEnum (Int -> Color) -> Int -> Color
forall a b. (a -> b) -> a -> b
$ Int
pI Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` 13 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2
            smlt :: Delta Time
smlt = Delta Time
smellTimeout Delta Time -> Delta Time -> Delta Time
`timeDeltaSubtract`
                     (Time
sml Time -> Time -> Delta Time
`timeDeltaToFrom` Time
ltime)
        in Color -> Char -> AttrCharW32
Color.attrChar2ToW32 Color
fg (Delta Time -> Delta Time -> Char
timeDeltaToDigit Delta Time
smellTimeout Delta Time
smlt)
      mapVAL :: forall a s. (PointI -> a -> Color.AttrCharW32) -> [(PointI, a)]
             -> FrameST s
      {-# INLINE mapVAL #-}
      mapVAL :: (Int -> a -> AttrCharW32) -> [(Int, a)] -> FrameST s
mapVAL f :: Int -> a -> AttrCharW32
f l :: [(Int, a)]
l v :: Mutable Vector s Word32
v = do
        let g :: (PointI, a) -> ST s ()
            g :: (Int, a) -> ST s ()
g (!Int
pI, !a
a0) = do
              let w :: Word32
w = AttrCharW32 -> Word32
Color.attrCharW32 (AttrCharW32 -> Word32) -> AttrCharW32 -> Word32
forall a b. (a -> b) -> a -> b
$ Int -> a -> AttrCharW32
f Int
pI a
a0
              MVector (PrimState (ST s)) Word32 -> Int -> Word32 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
VM.write MVector (PrimState (ST s)) Word32
Mutable Vector s Word32
v (Int
pI Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rXmax) Word32
w
        ((Int, a) -> ST s ()) -> [(Int, a)] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a.
(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
$ \v :: Mutable Vector s Word32
v -> do
        (Int -> ItemBag -> AttrCharW32) -> [(Int, ItemBag)] -> FrameST s
forall a s. (Int -> a -> AttrCharW32) -> [(Int, a)] -> FrameST s
mapVAL Int -> ItemBag -> AttrCharW32
viewItemBag (IntMap ItemBag -> [(Int, ItemBag)]
forall a. IntMap a -> [(Int, a)]
IM.assocs (IntMap ItemBag -> [(Int, ItemBag)])
-> IntMap ItemBag -> [(Int, ItemBag)]
forall a b. (a -> b) -> a -> b
$ ItemFloor -> IntMap ItemBag
forall k a. EnumMap k a -> IntMap a
EM.enumMapToIntMap ItemFloor
lfloor) Mutable Vector s Word32
v
        Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
smarkSmell (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
          (Int -> Time -> AttrCharW32) -> [(Int, Time)] -> FrameST s
forall a s. (Int -> a -> AttrCharW32) -> [(Int, a)] -> FrameST s
mapVAL Int -> Time -> AttrCharW32
viewSmell (((Int, Time) -> Bool) -> [(Int, Time)] -> [(Int, Time)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
> Time
ltime) (Time -> Bool) -> ((Int, Time) -> Time) -> (Int, Time) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Time) -> Time
forall a b. (a, b) -> b
snd)
                            ([(Int, Time)] -> [(Int, Time)]) -> [(Int, Time)] -> [(Int, Time)]
forall a b. (a -> b) -> a -> b
$ IntMap Time -> [(Int, Time)]
forall a. IntMap a -> [(Int, a)]
IM.assocs (IntMap Time -> [(Int, Time)]) -> IntMap Time -> [(Int, Time)]
forall a b. (a -> b) -> a -> b
$ SmellMap -> IntMap Time
forall k a. EnumMap k a -> IntMap a
EM.enumMapToIntMap SmellMap
lsmell) Mutable Vector s Word32
v
  FrameForall -> m FrameForall
forall (m :: * -> *) a. Monad m => a -> m a
return FrameForall
upd

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

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

drawFrameExtra :: forall m. MonadClientUI m
               => ColorMode -> LevelId -> m FrameForall
drawFrameExtra :: ColorMode -> LevelId -> m FrameForall
drawFrameExtra dm :: ColorMode
dm drawnLevelId :: LevelId
drawnLevelId = do
  COps{corule :: COps -> RuleContent
corule=RuleContent{Int
rXmax :: Int
rXmax :: RuleContent -> Int
rXmax, Int
rYmax :: Int
rYmax :: RuleContent -> Int
rYmax}} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  SessionUI{Maybe AimMode
saimMode :: Maybe AimMode
saimMode :: SessionUI -> Maybe AimMode
saimMode, Bool
smarkVision :: SessionUI -> Bool
smarkVision :: Bool
smarkVision} <- m SessionUI
forall (m :: * -> *). MonadClientUI m => m SessionUI
getSession
  -- Not @ScreenContent@, because indexing in level's data.
  EnumSet Point
totVisible <- Perception -> EnumSet Point
totalVisible (Perception -> EnumSet Point) -> m Perception -> m (EnumSet Point)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LevelId -> m Perception
forall (m :: * -> *). MonadClientRead m => LevelId -> m Perception
getPerFid LevelId
drawnLevelId
  Maybe Point
mxhairPos <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
xhairToPos
  Maybe Point
mtgtPos <- do
    Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
    case Maybe ActorId
mleader of
      Nothing -> Maybe Point -> m (Maybe Point)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Point
forall a. Maybe a
Nothing
      Just leader :: ActorId
leader -> do
        Maybe Target
mtgt <- (StateClient -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Maybe Target) -> m (Maybe Target))
-> (StateClient -> Maybe Target) -> m (Maybe Target)
forall a b. (a -> b) -> a -> b
$ ActorId -> StateClient -> Maybe Target
getTarget ActorId
leader
        (State -> Maybe Point) -> m (Maybe Point)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe Point) -> m (Maybe Point))
-> (State -> Maybe Point) -> m (Maybe Point)
forall a b. (a -> b) -> a -> b
$ ActorId -> LevelId -> Maybe Target -> State -> Maybe Point
aidTgtToPos ActorId
leader LevelId
drawnLevelId Maybe Target
mtgt
  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 =
        if Bool
smarkVision
        then IntSet -> [Int]
IS.toList (IntSet -> [Int]) -> IntSet -> [Int]
forall a b. (a -> b) -> a -> b
$ EnumSet Point -> IntSet
forall k. EnumSet k -> IntSet
ES.enumSetToIntSet EnumSet Point
totVisible
        else []
      backlightVision :: Color.AttrChar -> Color.AttrChar
      backlightVision :: AttrChar -> AttrChar
backlightVision ac :: AttrChar
ac = case AttrChar
ac of
        Color.AttrChar (Color.Attr fg :: Color
fg _) ch :: Char
ch ->
          Attr -> Char -> AttrChar
Color.AttrChar (Color -> Highlight -> Attr
Color.Attr Color
fg Highlight
Color.HighlightGrey) Char
ch
      writeSquare :: Highlight -> AttrChar -> AttrChar
writeSquare !Highlight
hi (Color.AttrChar (Color.Attr fg :: Color
fg bg :: Highlight
bg) ch :: Char
ch) =
        let hiUnlessLeader :: Highlight
hiUnlessLeader | Highlight
bg Highlight -> Highlight -> Bool
forall a. Eq a => a -> a -> Bool
== Highlight
Color.HighlightYellow = Highlight
bg
                           | Bool
otherwise = Highlight
hi
        in Attr -> Char -> AttrChar
Color.AttrChar (Color -> Highlight -> Attr
Color.Attr Color
fg Highlight
hiUnlessLeader) Char
ch
      turnBW :: AttrChar -> AttrChar
turnBW (Color.AttrChar _ ch :: Char
ch) = Attr -> Char -> AttrChar
Color.AttrChar Attr
Color.defAttr Char
ch
      mapVL :: forall s. (Color.AttrChar -> Color.AttrChar) -> [PointI]
            -> FrameST s
      mapVL :: (AttrChar -> AttrChar) -> [Int] -> FrameST s
mapVL f :: AttrChar -> AttrChar
f l :: [Int]
l v :: Mutable Vector s Word32
v = do
        let g :: PointI -> ST s ()
            g :: Int -> ST s ()
g !Int
pI = do
              Word32
w0 <- MVector (PrimState (ST s)) Word32 -> Int -> ST s Word32
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
VM.read MVector (PrimState (ST s)) Word32
Mutable Vector s Word32
v (Int
pI Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rXmax)
              let w :: Word32
w = AttrCharW32 -> Word32
Color.attrCharW32 (AttrCharW32 -> Word32)
-> (Word32 -> AttrCharW32) -> Word32 -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrChar -> AttrCharW32
Color.attrCharToW32
                      (AttrChar -> AttrCharW32)
-> (Word32 -> AttrChar) -> Word32 -> AttrCharW32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrChar -> AttrChar
f (AttrChar -> AttrChar)
-> (Word32 -> AttrChar) -> Word32 -> AttrChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrCharW32 -> AttrChar
Color.attrCharFromW32 (AttrCharW32 -> AttrChar)
-> (Word32 -> AttrCharW32) -> Word32 -> AttrChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> AttrCharW32
Color.AttrCharW32 (Word32 -> Word32) -> Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ Word32
w0
              MVector (PrimState (ST s)) Word32 -> Int -> Word32 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
VM.write MVector (PrimState (ST s)) Word32
Mutable Vector s Word32
v (Int
pI Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rXmax) Word32
w
        (Int -> ST s ()) -> [Int] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ Int -> ST s ()
g [Int]
l
      -- Here @rXmax@ and @rYmax@ are correct, because we are not
      -- turning the whole screen into black&white, but only the level map.
      lDungeon :: [Int]
lDungeon = [0..Int
rXmax Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
rYmax Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1]
      xhairColor :: Highlight
xhairColor = if Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isJust Maybe AimMode
saimMode
                   then Highlight
Color.HighlightRedAim
                   else Highlight
Color.HighlightRed
      locateStash :: (FactionId, Faction) -> Maybe (Point, Highlight)
locateStash (fid :: FactionId
fid, fact :: Faction
fact) = case Faction -> Maybe (LevelId, Point)
gstash Faction
fact of
        Just (lid :: LevelId
lid, pos :: 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 (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
$ \v :: Mutable Vector s Word32
v -> do
        Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isJust Maybe AimMode
saimMode) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ (AttrChar -> AttrChar) -> [Int] -> FrameST s
forall s. (AttrChar -> AttrChar) -> [Int] -> FrameST s
mapVL AttrChar -> AttrChar
backlightVision [Int]
visionMarks Mutable Vector s Word32
v
        case Maybe Point
mtgtPos of
          Nothing -> () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just p :: Point
p -> (AttrChar -> AttrChar) -> [Int] -> FrameST s
forall s. (AttrChar -> AttrChar) -> [Int] -> FrameST s
mapVL (Highlight -> AttrChar -> AttrChar
writeSquare Highlight
Color.HighlightGrey) [Point -> Int
forall a. Enum a => a -> Int
fromEnum Point
p] Mutable Vector s Word32
v
        ((Point, Highlight) -> ST s ()) -> [(Point, Highlight)] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (\(pos :: Point
pos, color :: Highlight
color) -> (AttrChar -> AttrChar) -> [Int] -> FrameST 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
          Nothing -> () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just p :: Point
p -> (AttrChar -> AttrChar) -> [Int] -> FrameST s
forall s. (AttrChar -> AttrChar) -> [Int] -> FrameST s
mapVL (Highlight -> AttrChar -> AttrChar
writeSquare Highlight
xhairColor) [Point -> Int
forall a. Enum a => a -> Int
fromEnum Point
p] Mutable Vector s Word32
v
        Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ColorMode
dm ColorMode -> ColorMode -> Bool
forall a. Eq a => a -> a -> Bool
== ColorMode
ColorBW) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ (AttrChar -> AttrChar) -> [Int] -> FrameST s
forall s. (AttrChar -> AttrChar) -> [Int] -> FrameST s
mapVL AttrChar -> AttrChar
turnBW [Int]
lDungeon Mutable Vector s Word32
v
  FrameForall -> m FrameForall
forall (m :: * -> *) a. Monad m => a -> m a
return FrameForall
upd

drawFrameStatus :: MonadClientUI m => LevelId -> m AttrString
drawFrameStatus :: LevelId -> m AttrString
drawFrameStatus drawnLevelId :: LevelId
drawnLevelId = do
  cops :: COps
cops@COps{corule :: COps -> RuleContent
corule=RuleContent{rXmax :: RuleContent -> Int
rXmax=Int
_rXmax}} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  SessionUI{EnumSet ActorId
sselected :: EnumSet ActorId
sselected :: SessionUI -> EnumSet ActorId
sselected, Maybe AimMode
saimMode :: Maybe AimMode
saimMode :: SessionUI -> Maybe AimMode
saimMode, Int
swaitTimes :: SessionUI -> Int
swaitTimes :: Int
swaitTimes, Maybe (ItemId, CStore, Bool)
sitemSel :: SessionUI -> Maybe (ItemId, CStore, Bool)
sitemSel :: Maybe (ItemId, CStore, Bool)
sitemSel} <- m SessionUI
forall (m :: * -> *). MonadClientUI m => m SessionUI
getSession
  Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
  Maybe Point
xhairPos <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
xhairToPos
  Maybe (Array BfsDistance)
mbfs <- m (Maybe (Array BfsDistance))
-> (ActorId -> m (Maybe (Array BfsDistance)))
-> Maybe ActorId
-> m (Maybe (Array BfsDistance))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe (Array BfsDistance) -> m (Maybe (Array BfsDistance))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Array BfsDistance)
forall a. Maybe a
Nothing) (\aid :: ActorId
aid -> Array BfsDistance -> Maybe (Array BfsDistance)
forall a. a -> Maybe a
Just (Array BfsDistance -> Maybe (Array BfsDistance))
-> m (Array BfsDistance) -> m (Maybe (Array BfsDistance))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActorId -> m (Array BfsDistance)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> m (Array BfsDistance)
getCacheBfs ActorId
aid) Maybe ActorId
mleader
  (mhairDesc :: Maybe Text
mhairDesc, mxhairHP :: Maybe Text
mxhairHP, mxhairWatchfulness :: 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
  (mblid :: Maybe LevelId
mblid, mbpos :: Maybe Point
mbpos, mbodyUI :: Maybe ActorUI
mbodyUI) <- case Maybe ActorId
mleader of
    Just leader :: ActorId
leader -> do
      Actor{Point
bpos :: Point
bpos :: Actor -> Point
bpos, LevelId
blid :: LevelId
blid :: Actor -> LevelId
blid} <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
      ActorUI
bodyUI <- (SessionUI -> ActorUI) -> m ActorUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> ActorUI) -> m ActorUI)
-> (SessionUI -> ActorUI) -> m ActorUI
forall a b. (a -> b) -> a -> b
$ ActorId -> SessionUI -> ActorUI
getActorUI ActorId
leader
      (Maybe LevelId, Maybe Point, Maybe ActorUI)
-> m (Maybe LevelId, Maybe Point, Maybe ActorUI)
forall (m :: * -> *) a. Monad m => a -> m a
return (LevelId -> Maybe LevelId
forall a. a -> Maybe a
Just LevelId
blid, Point -> Maybe Point
forall a. a -> Maybe a
Just Point
bpos, ActorUI -> Maybe ActorUI
forall a. a -> Maybe a
Just ActorUI
bodyUI)
    Nothing -> (Maybe LevelId, Maybe Point, Maybe ActorUI)
-> m (Maybe LevelId, Maybe Point, Maybe ActorUI)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe LevelId
forall a. Maybe a
Nothing, Maybe Point
forall a. Maybe a
Nothing, Maybe ActorUI
forall a. Maybe a
Nothing)
  let widthX :: Int
widthX = 80
      widthTgt :: Int
widthTgt = 39
      widthStatus :: Int
widthStatus = Int
widthX Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
widthTgt Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
      arenaStatus :: AttrString
arenaStatus = COps -> Level -> Int -> AttrString
drawArenaStatus COps
cops Level
lvl Int
widthStatus
      leaderStatusWidth :: Int
leaderStatusWidth = 23
  AttrString
leaderStatus <- Int -> m AttrString
forall (m :: * -> *). MonadClientUI m => Int -> m AttrString
drawLeaderStatus Int
swaitTimes
  (selectedStatusWidth :: Int
selectedStatusWidth, selectedStatus :: 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
    Nothing -> AttrString -> m AttrString
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Just leader :: 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 "?" else ""
          conditionBonus :: Int
conditionBonus = [ItemFullKit] -> Int
conditionSpeedBonus ([ItemFullKit] -> Int) -> [ItemFullKit] -> Int
forall a b. (a -> b) -> a -> b
$ ((ItemId, ItemFullKit) -> ItemFullKit)
-> [(ItemId, ItemFullKit)] -> [ItemFullKit]
forall a b. (a -> b) -> [a] -> [b]
map (ItemId, ItemFullKit) -> ItemFullKit
forall a b. (a, b) -> b
snd [(ItemId, ItemFullKit)]
kitAssRaw
          cspeed :: Color
cspeed = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
conditionBonus 0 of
            LT -> Color
Color.Red
            EQ -> Color
Color.White
            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 mp :: Maybe Point
mp mt :: Maybe Text
mt =
        let (plen :: Int
plen, llen :: Int
llen) | Just target :: Point
target <- Maybe Point
mp
                         , Just bfs :: Array BfsDistance
bfs <- Maybe (Array BfsDistance)
mbfs
                         , Just bpos :: Point
bpos <- Maybe Point
mbpos
                         , Maybe LevelId
mblid Maybe LevelId -> Maybe LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId -> Maybe LevelId
forall a. a -> Maybe a
Just LevelId
drawnLevelId
                         = ( Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 0 (Array BfsDistance -> Point -> Maybe Int
accessBfs Array BfsDistance
bfs Point
target)
                           , Point -> Point -> Int
chessDist Point
bpos Point
target )
                         | Bool
otherwise = (0, 0)
            pText :: Text
pText | Int
plen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = ""
                  | Bool
otherwise = "p" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
plen
            lText :: Text
lText | Int
llen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = ""
                  | Bool
otherwise = "l" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
llen
            text :: Text
text = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (Text
pText Text -> Text -> Text
<+> Text
lText) Maybe Text
mt
        in if Text -> Bool
T.null Text
text then "" else " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
text
      -- The indicators must fit, they are the actual information.
      pathCsr :: Text
pathCsr = Maybe Point -> Maybe Text -> Text
displayPathText Maybe Point
xhairPos Maybe Text
mxhairHP
      trimTgtDesc :: Int -> Text -> Text
trimTgtDesc n :: Int
n t :: Text
t = Bool -> Text -> Text
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not (Text -> Bool
T.null Text
t) Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 2 Bool -> (Text, Int) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (Text
t, Int
n)) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
        if Text -> Int
T.length Text
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n then Text
t else Int -> Text -> Text
T.take (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- 3) Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "..."
      -- The indicators must fit, they are the actual information.
      widthXhairOrItem :: Int
widthXhairOrItem = Int
widthTgt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
pathCsr
      nMember :: Part
nMember = Int -> Part
MU.Ord (Int -> Part) -> Int -> Part
forall a b. (a -> b) -> a -> b
$ 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall a. Num a => [a] -> a
sum (EnumMap (ContentId ItemKind) Int -> [Int]
forall k a. EnumMap k a -> [a]
EM.elems (EnumMap (ContentId ItemKind) Int -> [Int])
-> EnumMap (ContentId ItemKind) Int -> [Int]
forall a b. (a -> b) -> a -> b
$ Faction -> EnumMap (ContentId ItemKind) Int
gvictims Faction
fact)
      fallback :: Text
fallback = if Player -> LeaderMode
MK.fleaderMode (Faction -> Player
gplayer Faction
fact) LeaderMode -> LeaderMode -> Bool
forall a. Eq a => a -> a -> Bool
== LeaderMode
MK.LeaderNull
                 then "This faction never picks a pointman"
                 else [Part] -> Text
makePhrase
                        ["Waiting for", Part
nMember, "team member to spawn"]
      leaderName :: ActorUI -> Text
leaderName bUI :: ActorUI
bUI = Int -> Text -> Text
trimTgtDesc (Int
widthTgt Int -> Int -> Int
forall a. Num a => a -> a -> a
- 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 (\bUI :: ActorUI
bUI ->
        "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 [ "Team:"
                   , Int -> Part -> Part
MU.CarWs Int
na "actor", "on"
                   , Int -> Part -> Part
MU.CarWs Int
nl "level" Part -> Part -> Part
forall a. Semigroup a => a -> a -> a
<> ","
                   , "stash", Int -> Part
MU.Car Int
ns ]
      markSleepTgtDesc :: Text -> 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} =
        "x" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow (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
aimMode = "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
          (\t :: Text
t -> case Maybe AimMode
saimMode of
             Just aimMode :: AimMode
aimMode ->
               Text -> AttrString
textToAS (AimMode -> Text
xhairName AimMode
aimMode Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ":")
               AttrString -> AttrString -> AttrString
<+:> Text -> AttrString
markSleepTgtDesc (Int -> Text -> Text
trimTgtDesc (Int
widthXhairOrItem Int -> Int -> Int
forall a. Num a => a -> a -> a
- 14) Text
t)
             Nothing -> Text -> AttrString
markSleepTgtDesc (Int -> Text -> Text
trimTgtDesc Int
widthXhairOrItem Text
t))
          Maybe Text
mhairDesc
      tgtOrItem :: m (AttrString, Text)
tgtOrItem
        | Just (iid :: ItemId
iid, fromCStore :: CStore
fromCStore, _) <- Maybe (ItemId, CStore, Bool)
sitemSel
        , Just leader :: ActorId
leader <- Maybe ActorId
mleader
        = do
            Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
            ItemBag
bag <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ Actor -> CStore -> State -> ItemBag
getBodyStoreBag Actor
b CStore
fromCStore
            case ItemId
iid ItemId -> ItemBag -> Maybe ItemQuant
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` ItemBag
bag of
              Nothing -> (AttrString, Text) -> m (AttrString, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (AttrString
xhairBlurb, Text
pathCsr)
              Just kit :: ItemQuant
kit@(k :: Int
k, _) -> do
                Time
localTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime (Actor -> LevelId
blid Actor
b)
                ItemFull
itemFull <- (State -> ItemFull) -> m ItemFull
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemFull) -> m ItemFull)
-> (State -> ItemFull) -> m ItemFull
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemFull
itemToFull ItemId
iid
                FactionDict
factionD <- (State -> FactionDict) -> m FactionDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
                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 (name :: Part
name, powers :: 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
forall a. Semigroup a => a -> a -> a
<>) Maybe Text
mxhairHP
                    (xItemWidth :: Int
xItemWidth, xItemText :: Text
xItemText) = case Maybe AimMode
saimMode of
                      Just aimMode :: AimMode
aimMode -> (9, "Item" Text -> Text -> Text
<+> AimMode -> Text
xdetail AimMode
aimMode)
                      Nothing -> (6, "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
trimTD, Text
xhairHP)
        | Bool
otherwise =
            (AttrString, Text) -> m (AttrString, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (AttrString
xhairBlurb, Text
pathCsr)
  (xhairLine :: AttrString
xhairLine, pathXhairOrNull :: 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
- 1
      leaderBottom :: Text
leaderBottom =
        if | Text -> Int
T.length Text
leaderBlurbShort Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
withForLeader -> ""
           | Text -> Int
T.length Text
leaderBlurbLong Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
withForLeader -> Text
leaderBlurbShort
           | Bool
otherwise -> Text
leaderBlurbLong
      damageGap :: 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
== 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
_rXmax
              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 dm :: ColorMode
dm drawnLevelId :: LevelId
drawnLevelId = do
  Vector Word32
baseTerrain <- LevelId -> m (Vector Word32)
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> m (Vector Word32)
drawFrameTerrain LevelId
drawnLevelId
  FrameForall
updContent <- LevelId -> m FrameForall
forall (m :: * -> *). MonadClientUI m => LevelId -> m FrameForall
drawFrameContent LevelId
drawnLevelId
  FrameForall
updPath <- LevelId -> m FrameForall
forall (m :: * -> *). MonadClientUI m => LevelId -> m FrameForall
drawFramePath LevelId
drawnLevelId
  FrameForall
updActor <- LevelId -> m FrameForall
forall (m :: * -> *). MonadClientUI m => LevelId -> m FrameForall
drawFrameActor LevelId
drawnLevelId
  FrameForall
updExtra <- ColorMode -> LevelId -> m FrameForall
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> LevelId -> m FrameForall
drawFrameExtra ColorMode
dm LevelId
drawnLevelId
  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
$ \v :: Mutable Vector s Word32
v -> do
        FrameForall -> FrameST s
FrameForall -> forall s. FrameST s
unFrameForall FrameForall
updContent Mutable Vector s Word32
v
        -- vty frontend is screen-reader friendly, so avoid visual fluff
        Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ClientOptions -> [Char]
frontendName ClientOptions
soptions [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== "vty") (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ FrameForall -> FrameST s
FrameForall -> forall s. FrameST s
unFrameForall FrameForall
updPath Mutable Vector s Word32
v
        FrameForall -> FrameST s
FrameForall -> forall s. FrameST s
unFrameForall FrameForall
updActor Mutable Vector s Word32
v
        FrameForall -> FrameST s
FrameForall -> forall s. FrameST s
unFrameForall FrameForall
updExtra Mutable Vector s Word32
v
  PreFrame -> m PreFrame
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector Word32
baseTerrain, FrameForall
upd)

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

drawLeaderStatus :: MonadClientUI m => Int -> m AttrString
drawLeaderStatus :: Int -> m AttrString
drawLeaderStatus waitT :: Int
waitT = do
  Time
time <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Time
stime
  let calmHeaderText :: [Char]
calmHeaderText = "Calm"
      hpHeaderText :: [Char]
hpHeaderText = "HP"
      slashes :: [[Char]]
slashes = ["/", "|", "\\", "|"]
      waitGlobal :: Int
waitGlobal = Time -> Time -> Int
timeFit Time
time Time
timeTurn
  UIOptions
sUIOptions <- (SessionUI -> UIOptions) -> m UIOptions
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> UIOptions
sUIOptions
  Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
  case Maybe ActorId
mleader of
    Just leader :: ActorId
leader -> do
      Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
      Skills
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
      (hpCheckWarning :: Bool
hpCheckWarning, calmCheckWarning :: Bool
calmCheckWarning)
        <- (State -> (Bool, Bool)) -> m (Bool, Bool)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> (Bool, Bool)) -> m (Bool, Bool))
-> (State -> (Bool, Bool)) -> m (Bool, Bool)
forall a b. (a -> b) -> a -> b
$ UIOptions -> ActorId -> State -> (Bool, Bool)
checkWarnings UIOptions
sUIOptions ActorId
leader
      Bool
bdark <- (State -> Bool) -> m Bool
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ 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 x :: a
x = let t :: [Char]
t = a -> [Char]
forall a. Show a => a -> [Char]
show a
x
                        in if [Char] -> Int
forall a. [a] -> Int
length [Char]
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 3
                           then if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then "***" else "---"
                           else [Char]
t
          waitSlash :: Int
waitSlash | Actor -> Watchfulness
bwatch Actor
b Watchfulness -> Watchfulness -> Bool
forall a. Eq a => a -> a -> Bool
== Watchfulness
WSleep = Int
waitGlobal
                    | Bool
otherwise = Int -> Int
forall a. Num a => a -> a
abs Int
waitT
          -- This is a valuable feedback for the otherwise hard to observe
          -- 'wait' command or for passing of time when sole leader sleeps.
          slashPick :: [Char]
slashPick = [[Char]]
slashes [[Char]] -> Int -> [Char]
forall a. [a] -> Int -> a
!! (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 Int
waitSlash Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` [[Char]] -> Int
forall a. [a] -> Int
length [[Char]]
slashes)
          addColor :: Color -> [Char] -> AttrString
addColor c :: 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) -> Int64
forall a b. (a, b) -> a
fst (Int64, Int64)
resCurrentTurn Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< 0 Bool -> Bool -> Bool
|| (Int64, Int64) -> Int64
forall a b. (a, b) -> a
fst (Int64, Int64)
resPreviousTurn Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< 0
              = Color -> [Char] -> 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
> 0 Bool -> Bool -> Bool
|| (Int64, Int64) -> Int64
forall a b. (a, b) -> b
snd (Int64, Int64)
resPreviousTurn Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> 0
              = Color -> [Char] -> AttrString
addColor Color
Color.BrGreen
            | Bool
otherwise = [Char] -> AttrString
stringToAS  -- only if nothing at all noteworthy
          checkSleep :: Actor -> ResDelta -> [Char] -> AttrString
checkSleep body :: Actor
body resDelta :: ResDelta
resDelta
            | Actor -> Watchfulness
bwatch Actor
body Watchfulness -> Watchfulness -> Bool
forall a. Eq a => a -> a -> Bool
== Watchfulness
WSleep = Color -> [Char] -> 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 = "."
                   | Bool
otherwise = ":"
          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 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]
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 = "}"
                    | Bool
otherwise = ":"
          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 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]
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 n :: Int
n t :: [Char]
t = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Char] -> Int
forall a. [a] -> Int
length [Char]
t) ' ' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
t
          colorWarning :: Bool -> Bool -> Bool -> [Char] -> AttrString
colorWarning w :: Bool
w enough :: Bool
enough full :: 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 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 7 [Char]
hpText)
    Nothing -> do
      -- This is a valuable feedback for passing of time while faction
      -- leaderless and especially while temporarily actor-less..
      let slashPick :: [Char]
slashPick = [[Char]]
slashes [[Char]] -> Int -> [Char]
forall a. [a] -> Int -> a
!! (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 Int
waitGlobal Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` [[Char]] -> Int
forall a. [a] -> Int
length [[Char]]
slashes)
      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]
forall a. [a] -> [a] -> [a]
++ [Char]
slashPick [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "--")
                AttrString -> AttrString -> AttrString
<+:> [Char] -> AttrString
stringToAS ([Char]
hpHeaderText [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> ":  --/--")

drawLeaderDamage :: MonadClientUI m => Int -> ActorId -> m AttrString
drawLeaderDamage :: Int -> ActorId -> m AttrString
drawLeaderDamage width :: Int
width leader :: ActorId
leader = do
  [(ItemId, ItemFullKit)]
kitAssRaw <- (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)])
-> (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
forall a b. (a -> b) -> a -> b
$ ActorId -> [CStore] -> State -> [(ItemId, ItemFullKit)]
kitAssocs ActorId
leader [CStore
CEqp, CStore
COrgan]
  Skills
actorCurAndMaxSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
  let unBurn :: Effect -> Maybe Dice
unBurn (IK.Burn d :: Dice
d) = Dice -> Maybe Dice
forall a. a -> Maybe a
Just Dice
d
      unBurn _ = Maybe Dice
forall a. Maybe a
Nothing
      unRefillHP :: Effect -> Maybe Int
unRefillHP (IK.RefillHP n :: Int
n) = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n
      unRefillHP _ = Maybe Int
forall a. Maybe a
Nothing
      hasNonDamagesEffect :: ItemFull -> Bool
hasNonDamagesEffect itemFull :: ItemFull
itemFull =
        (Effect -> Bool) -> [Effect] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\eff :: 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 showInBrief :: Bool
showInBrief (hasEffect :: Bool
hasEffect, timeout :: Int
timeout, nch :: Int
nch, (itemFull :: ItemFull
itemFull, (k :: Int
k, _))) =
        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 d :: Int
d | Bool
showInBrief -> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
d
              _ -> 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]
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 0 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min 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
< 0 = '+' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Int -> [Char]
forall a. Show a => a -> [Char]
show (- Int
nRefillHP)
                      | Bool
otherwise = ""
            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
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 charged :: 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
> 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
nch)
                          (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
nch (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 200 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (-200) Int
bonusRaw
            unknownBonus :: Bool
unknownBonus = [ItemFull] -> Bool
unknownMeleeBonus ([ItemFull] -> Bool) -> [ItemFull] -> Bool
forall a b. (a -> b) -> a -> b
$ ((ItemId, ItemFullKit) -> ItemFull)
-> [(ItemId, ItemFullKit)] -> [ItemFull]
forall a b. (a -> b) -> [a] -> [b]
map (ItemFullKit -> ItemFull
forall a b. (a, b) -> a
fst (ItemFullKit -> ItemFull)
-> ((ItemId, ItemFullKit) -> ItemFullKit)
-> (ItemId, ItemFullKit)
-> ItemFull
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ItemId, ItemFullKit) -> ItemFullKit
forall a b. (a, b) -> b
snd) [(ItemId, ItemFullKit)]
kitAssRaw
            tbonus :: [Char]
tbonus = if Int
bonus Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0
                     then if Bool
unknownBonus then "+?" else ""
                     else (if Int
bonus Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then "+" else "")
                          [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
bonus
                          [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> (if Int
bonus Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
bonusRaw then "$" else "")
                          [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> if Bool
unknownBonus then "%?" else "%"
            conditionBonus :: Int
conditionBonus = [ItemFullKit] -> Int
conditionMeleeBonus ([ItemFullKit] -> Int) -> [ItemFullKit] -> Int
forall a b. (a -> b) -> a -> b
$ ((ItemId, ItemFullKit) -> ItemFullKit)
-> [(ItemId, ItemFullKit)] -> [ItemFullKit]
forall a b. (a -> b) -> [a] -> [b]
map (ItemId, ItemFullKit) -> ItemFullKit
forall a b. (a, b) -> b
snd [(ItemId, ItemFullKit)]
kitAssRaw
            cbonus :: Color
cbonus = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
conditionBonus 0 of
              LT -> Color
Color.Red
              EQ -> Color
Color.White
              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 (\(_, hasEffect :: Bool
hasEffect, timeout :: Int
timeout, ncha :: Int
ncha, _, itemFullKit :: 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 (_, timeout :: a
timeout, _, (itemFull :: ItemFull
itemFull, _)) =
        a
timeout a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
|| ItemFull -> Bool
itemSuspect ItemFull
itemFull
      (lT :: [(Bool, Int, Int, ItemFullKit)]
lT, lTrest :: [(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
        [] -> []
        noTimeout :: (Bool, Int, Int, ItemFullKit)
noTimeout : lTrest2 :: [(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 showInBrief :: Bool
showInBrief l :: 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
            (ldischarged :: [(Bool, (AttrString, AttrString))]
ldischarged, lrest :: [(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
              (ldmg :: AttrString
ldmg, lextra :: AttrString
lextra) : rest :: [(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 (ldmg :: AttrString
ldmg, lextra :: 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
== "0"
              then case AttrString
lextra of
                [] -> AttrString
ldmg
                _plus :: AttrCharW32
_plus : lextraRest :: 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
- 3) AttrString
lBrief AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ [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
lFits

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

checkWarningCalm :: UIOptions -> ActorId -> Int64 -> State -> Bool
checkWarningCalm :: UIOptions -> ActorId -> Int64 -> State -> Bool
checkWarningCalm UIOptions{Int
uhpWarningPercent :: Int
uhpWarningPercent :: UIOptions -> Int
uhpWarningPercent} leader :: ActorId
leader calm :: Int64
calm s :: State
s =
  let b :: Actor
b = ActorId -> State -> Actor
getActorBody ActorId
leader State
s
      actorCurAndMaxSk :: Skills
actorCurAndMaxSk = ActorId -> State -> Skills
getActorMaxSkills ActorId
leader State
s
      isImpression :: ItemId -> Bool
isImpression iid :: ItemId
iid =
        Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ GroupName ItemKind -> [(GroupName ItemKind, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup 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` 100)
     Bool -> Bool -> Bool
&& Bool
isImpressed

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