module Game.LambdaHack.Client.UI.DrawM
( targetDesc, targetDescXhair, drawHudFrame
, checkWarningHP, checkWarningCalm
#ifdef EXPOSE_INTERNAL
, 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
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
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
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
|
Int
pI Int -> IntSet -> Bool
`IS.member` EnumSet Point -> IntSet
forall k. EnumSet k -> IntSet
ES.enumSetToIntSet EnumSet Point
totVisible
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
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
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
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
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
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
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
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
FrameForall -> m FrameForall
forall (m :: * -> *) a. Monad m => a -> m a
return FrameForall
upd
drawFrameExtra :: forall m. MonadClientUI m
=> ColorMode -> LevelId -> m FrameForall
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
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
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
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
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
<> "..."
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
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)
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
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
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)
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
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
| (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
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
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
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
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
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
[] -> []
(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
| 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}) =
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 )