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.Frame
import Game.LambdaHack.Client.UI.Frontend (frontendName)
import Game.LambdaHack.Client.UI.ItemDescription
import Game.LambdaHack.Client.UI.MonadClientUI
import Game.LambdaHack.Client.UI.Overlay
import Game.LambdaHack.Client.UI.SessionUI
import Game.LambdaHack.Client.UI.UIOptions
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import Game.LambdaHack.Common.Kind
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Perception
import Game.LambdaHack.Common.Point
import qualified Game.LambdaHack.Common.PointArray as PointArray
import Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Common.Types
import Game.LambdaHack.Common.Vector
import Game.LambdaHack.Content.CaveKind (cname)
import qualified Game.LambdaHack.Content.ItemKind as IK
import qualified Game.LambdaHack.Content.ModeKind as MK
import Game.LambdaHack.Content.RuleKind
import Game.LambdaHack.Content.TileKind (TileKind, isUknownSpace)
import qualified Game.LambdaHack.Content.TileKind as TK
import qualified Game.LambdaHack.Core.Dice as Dice
import qualified Game.LambdaHack.Definition.Ability as Ability
import qualified Game.LambdaHack.Definition.Color as Color
import Game.LambdaHack.Definition.Defs
targetDesc :: MonadClientUI m => Maybe Target -> m (Maybe Text, Maybe Text)
targetDesc :: Maybe Target -> m (Maybe Text, Maybe Text)
targetDesc mtarget :: Maybe Target
mtarget = do
LevelId
arena <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
let describeActorTarget :: ActorId -> m (Maybe Text, Maybe Text)
describeActorTarget aid :: ActorId
aid = do
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
ActorUI
bUI <- (SessionUI -> ActorUI) -> m ActorUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> ActorUI) -> m ActorUI)
-> (SessionUI -> ActorUI) -> m ActorUI
forall a b. (a -> b) -> a -> b
$ ActorId -> SessionUI -> ActorUI
getActorUI ActorId
aid
Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
aid
let percentage :: Int64
percentage =
100 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Actor -> Int64
bhp Actor
b
Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int -> Int64
xM (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 5 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMaxHP Skills
actorMaxSk)
chs :: Int -> Text
chs n :: Int
n = "[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate Int
n "*"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (4 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) "_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "]"
stars :: Text
stars = Int -> Text
chs (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int64 -> Int
forall a. Enum a => a -> Int
fromEnum (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
max 0 (Int64 -> Int64) -> Int64 -> Int64
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
min 4 (Int64 -> Int64) -> Int64 -> Int64
forall a b. (a -> b) -> a -> b
$ Int64
percentage Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` 20
hpIndicator :: Maybe Text
hpIndicator = if Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
stars
(Maybe Text, Maybe Text) -> m (Maybe Text, Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ ActorUI -> Text
bname ActorUI
bUI, Maybe Text
hpIndicator)
case Maybe Target
mtarget of
Just (TEnemy aid :: ActorId
aid) -> ActorId -> m (Maybe Text, Maybe Text)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> m (Maybe Text, Maybe Text)
describeActorTarget ActorId
aid
Just (TNonEnemy aid :: ActorId
aid) -> ActorId -> m (Maybe Text, Maybe Text)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> m (Maybe Text, Maybe Text)
describeActorTarget ActorId
aid
Just (TPoint tgoal :: TGoal
tgoal lid :: LevelId
lid p :: Point
p) -> case TGoal
tgoal of
TEnemyPos{} -> do
let hotText :: Text
hotText = if LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV Bool -> Bool -> Bool
&& LevelId
arena LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV
then "hot spot" Text -> Text -> Text
<+> Point -> Text
forall a. Show a => a -> Text
tshow Point
p
else "a hot spot on level" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ LevelId -> Int
forall a. Enum a => a -> Int
fromEnum LevelId
lid)
(Maybe Text, Maybe Text) -> m (Maybe Text, Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
hotText, Maybe Text
forall a. Maybe a
Nothing)
_ -> do
Text
pointedText <-
if LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV Bool -> Bool -> Bool
&& LevelId
arena LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV
then do
ItemBag
bag <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ LevelId -> Point -> State -> ItemBag
getFloorBag LevelId
lid Point
p
case ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs ItemBag
bag of
[] -> Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$! "exact spot" Text -> Text -> Text
<+> Point -> Text
forall a. Show a => a -> Text
tshow Point
p
[(iid :: ItemId
iid, kit :: ItemQuant
kit@(k :: Int
k, _))] -> do
Time
localTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime LevelId
lid
ItemFull
itemFull <- (State -> ItemFull) -> m ItemFull
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemFull) -> m ItemFull)
-> (State -> ItemFull) -> m ItemFull
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemFull
itemToFull ItemId
iid
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
FactionDict
factionD <- (State -> FactionDict) -> m FactionDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
let (name :: Part
name, powers :: Part
powers) =
FactionId
-> FactionDict -> Time -> ItemFull -> ItemQuant -> (Part, Part)
partItem FactionId
side FactionDict
factionD Time
localTime ItemFull
itemFull ItemQuant
kit
Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$! [Part] -> Text
makePhrase [Int -> Part -> Part
MU.Car1Ws Int
k Part
name, Part
powers]
_ -> Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$! "many items at" Text -> Text -> Text
<+> Point -> Text
forall a. Show a => a -> Text
tshow Point
p
else Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$! "an exact spot on level" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ LevelId -> Int
forall a. Enum a => a -> Int
fromEnum LevelId
lid)
(Maybe Text, Maybe Text) -> m (Maybe Text, Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
pointedText, Maybe Text
forall a. Maybe a
Nothing)
Just TVector{} ->
case Maybe ActorId
mleader of
Nothing -> (Maybe Text, Maybe Text) -> m (Maybe Text, Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Maybe Text
forall a. a -> Maybe a
Just "a relative shift", Maybe Text
forall a. Maybe a
Nothing)
Just aid :: ActorId
aid -> do
Maybe Point
tgtPos <- (State -> Maybe Point) -> m (Maybe Point)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe Point) -> m (Maybe Point))
-> (State -> Maybe Point) -> m (Maybe Point)
forall a b. (a -> b) -> a -> b
$ ActorId -> LevelId -> Maybe Target -> State -> Maybe Point
aidTgtToPos ActorId
aid LevelId
lidV Maybe Target
mtarget
let invalidMsg :: Text
invalidMsg = "an invalid relative shift"
validMsg :: a -> Text
validMsg p :: a
p = "shift to" Text -> Text -> Text
<+> a -> Text
forall a. Show a => a -> Text
tshow a
p
(Maybe Text, Maybe Text) -> m (Maybe Text, Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> (Point -> Text) -> Maybe Point -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
invalidMsg Point -> Text
forall a. Show a => a -> Text
validMsg Maybe Point
tgtPos, Maybe Text
forall a. Maybe a
Nothing)
Nothing -> (Maybe Text, Maybe Text) -> m (Maybe Text, Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text
forall a. Maybe a
Nothing, Maybe Text
forall a. Maybe a
Nothing)
targetDescXhair :: MonadClientUI m => m (Maybe Text, Maybe (Text, Watchfulness))
targetDescXhair :: m (Maybe Text, Maybe (Text, Watchfulness))
targetDescXhair = do
Maybe Target
sxhair <- (SessionUI -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhair
(mhairDesc :: Maybe Text
mhairDesc, mxhairHP :: Maybe Text
mxhairHP) <- Maybe Target -> m (Maybe Text, Maybe Text)
forall (m :: * -> *).
MonadClientUI m =>
Maybe Target -> m (Maybe Text, Maybe Text)
targetDesc Maybe Target
sxhair
case Maybe Text
mxhairHP of
Nothing -> (Maybe Text, Maybe (Text, Watchfulness))
-> m (Maybe Text, Maybe (Text, Watchfulness))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text
mhairDesc, Maybe (Text, Watchfulness)
forall a. Maybe a
Nothing)
Just tHP :: Text
tHP -> do
let aid :: ActorId
aid = case Maybe Target
sxhair of
Just (TEnemy a :: ActorId
a) -> ActorId
a
Just (TNonEnemy a :: ActorId
a) -> ActorId
a
_ -> [Char] -> ActorId
forall a. HasCallStack => [Char] -> a
error ([Char] -> ActorId) -> [Char] -> ActorId
forall a b. (a -> b) -> a -> b
$ "HP text for non-actor target" [Char] -> Maybe Target -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` Maybe Target
sxhair
Watchfulness
watchfulness <- Actor -> Watchfulness
bwatch (Actor -> Watchfulness) -> m Actor -> m Watchfulness
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState (ActorId -> State -> Actor
getActorBody ActorId
aid)
(Maybe Text, Maybe (Text, Watchfulness))
-> m (Maybe Text, Maybe (Text, Watchfulness))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe Text, Maybe (Text, Watchfulness))
-> m (Maybe Text, Maybe (Text, Watchfulness)))
-> (Maybe Text, Maybe (Text, Watchfulness))
-> m (Maybe Text, Maybe (Text, Watchfulness))
forall a b. (a -> b) -> a -> b
$ (Maybe Text
mhairDesc, (Text, Watchfulness) -> Maybe (Text, Watchfulness)
forall a. a -> Maybe a
Just (Text
tHP, Watchfulness
watchfulness))
drawFrameTerrain :: forall m. MonadClientUI m => LevelId -> m (U.Vector Word32)
drawFrameTerrain :: LevelId -> m (Vector Word32)
drawFrameTerrain drawnLevelId :: LevelId
drawnLevelId = do
COps{corule :: COps -> RuleContent
corule=RuleContent{Int
rXmax :: RuleContent -> Int
rXmax :: Int
rXmax}, ContentData TileKind
cotile :: COps -> ContentData TileKind
cotile :: ContentData TileKind
cotile, TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
StateClient{Int
smarkSuspect :: StateClient -> Int
smarkSuspect :: Int
smarkSuspect} <- m StateClient
forall (m :: * -> *). MonadClientRead m => m StateClient
getClient
Level{ltile :: Level -> TileMap
ltile=PointArray.Array{Vector (UnboxRep (ContentId TileKind))
avector :: forall c. Array c -> Vector (UnboxRep c)
avector :: Vector (UnboxRep (ContentId TileKind))
avector}, ItemFloor
lembed :: Level -> ItemFloor
lembed :: ItemFloor
lembed} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
drawnLevelId
EnumSet Point
totVisible <- Perception -> EnumSet Point
totalVisible (Perception -> EnumSet Point) -> m Perception -> m (EnumSet Point)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LevelId -> m Perception
forall (m :: * -> *). MonadClientRead m => LevelId -> m Perception
getPerFid LevelId
drawnLevelId
AttrLine
frameStatus <- LevelId -> m AttrLine
forall (m :: * -> *). MonadClientUI m => LevelId -> m AttrLine
drawFrameStatus LevelId
drawnLevelId
let dis :: PointI -> ContentId TileKind -> Color.AttrCharW32
{-# INLINE dis #-}
dis :: Int -> ContentId TileKind -> AttrCharW32
dis pI :: Int
pI tile :: ContentId TileKind
tile =
let TK.TileKind{Char
tsymbol :: TileKind -> Char
tsymbol :: Char
tsymbol, Color
tcolor :: TileKind -> Color
tcolor :: Color
tcolor, Color
tcolor2 :: TileKind -> Color
tcolor2 :: Color
tcolor2} = ContentData TileKind -> ContentId TileKind -> TileKind
forall a. ContentData a -> ContentId a -> a
okind ContentData TileKind
cotile ContentId TileKind
tile
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) -> AttrLine -> [Word32]
forall a b. (a -> b) -> [a] -> [b]
map AttrCharW32 -> Word32
Color.attrCharW32 AttrLine
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 b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Int, a) -> ST s ()
g [(Int, a)]
l
upd :: FrameForall
upd :: FrameForall
upd = (forall s. FrameST s) -> FrameForall
FrameForall ((forall s. FrameST s) -> FrameForall)
-> (forall s. FrameST s) -> FrameForall
forall a b. (a -> b) -> a -> b
$ \v :: Mutable Vector s Word32
v -> do
(Int -> ItemBag -> AttrCharW32) -> [(Int, ItemBag)] -> FrameST s
forall a s. (Int -> a -> AttrCharW32) -> [(Int, a)] -> FrameST s
mapVAL Int -> ItemBag -> AttrCharW32
viewItemBag (IntMap ItemBag -> [(Int, ItemBag)]
forall a. IntMap a -> [(Int, a)]
IM.assocs (IntMap ItemBag -> [(Int, ItemBag)])
-> IntMap ItemBag -> [(Int, ItemBag)]
forall a b. (a -> b) -> a -> b
$ ItemFloor -> IntMap ItemBag
forall k a. EnumMap k a -> IntMap a
EM.enumMapToIntMap ItemFloor
lfloor) Mutable Vector s Word32
v
Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
smarkSmell (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
(Int -> Time -> AttrCharW32) -> [(Int, Time)] -> FrameST s
forall a s. (Int -> a -> AttrCharW32) -> [(Int, a)] -> FrameST s
mapVAL Int -> Time -> AttrCharW32
viewSmell (((Int, Time) -> Bool) -> [(Int, Time)] -> [(Int, Time)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
> Time
ltime) (Time -> Bool) -> ((Int, Time) -> Time) -> (Int, Time) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Time) -> Time
forall a b. (a, b) -> b
snd)
([(Int, Time)] -> [(Int, Time)]) -> [(Int, Time)] -> [(Int, Time)]
forall a b. (a -> b) -> a -> b
$ IntMap Time -> [(Int, Time)]
forall a. IntMap a -> [(Int, a)]
IM.assocs (IntMap Time -> [(Int, Time)]) -> IntMap Time -> [(Int, Time)]
forall a b. (a -> b) -> a -> b
$ SmellMap -> IntMap Time
forall k a. EnumMap k a -> IntMap a
EM.enumMapToIntMap SmellMap
lsmell) Mutable Vector s Word32
v
FrameForall -> m FrameForall
forall (m :: * -> *) a. Monad m => a -> m a
return FrameForall
upd
drawFramePath :: forall m. MonadClientUI m => LevelId -> m FrameForall
drawFramePath :: LevelId -> m FrameForall
drawFramePath drawnLevelId :: LevelId
drawnLevelId = do
SessionUI{Maybe AimMode
saimMode :: SessionUI -> Maybe AimMode
saimMode :: Maybe AimMode
saimMode} <- m SessionUI
forall (m :: * -> *). MonadClientUI m => m SessionUI
getSession
if Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isNothing Maybe AimMode
saimMode then FrameForall -> m FrameForall
forall (m :: * -> *) a. Monad m => a -> m a
return (FrameForall -> m FrameForall) -> FrameForall -> m FrameForall
forall a b. (a -> b) -> a -> b
$! (forall s. FrameST s) -> FrameForall
FrameForall ((forall s. FrameST s) -> FrameForall)
-> (forall s. FrameST s) -> FrameForall
forall a b. (a -> b) -> a -> b
$ \_ -> () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else do
COps{corule :: COps -> RuleContent
corule=RuleContent{Int
rXmax :: Int
rXmax :: RuleContent -> Int
rXmax, Int
rYmax :: RuleContent -> Int
rYmax :: Int
rYmax}, TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
StateClient{Int
seps :: StateClient -> Int
seps :: Int
seps} <- m StateClient
forall (m :: * -> *). MonadClientRead m => m StateClient
getClient
Level{ltile :: Level -> TileMap
ltile=PointArray.Array{Vector (UnboxRep (ContentId TileKind))
avector :: Vector (UnboxRep (ContentId TileKind))
avector :: forall c. Array c -> Vector (UnboxRep c)
avector}} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
drawnLevelId
EnumSet Point
totVisible <- Perception -> EnumSet Point
totalVisible (Perception -> EnumSet Point) -> m Perception -> m (EnumSet Point)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LevelId -> m Perception
forall (m :: * -> *). MonadClientRead m => LevelId -> m Perception
getPerFid LevelId
drawnLevelId
Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
Maybe Point
mpos <- (State -> Maybe Point) -> m (Maybe Point)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe Point) -> m (Maybe Point))
-> (State -> Maybe Point) -> m (Maybe Point)
forall a b. (a -> b) -> a -> b
$ \s :: State
s -> Actor -> Point
bpos (Actor -> Point) -> (ActorId -> Actor) -> ActorId -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId -> State -> Actor
`getActorBody` State
s) (ActorId -> Point) -> Maybe ActorId -> Maybe Point
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ActorId
mleader
Maybe Point
xhairPosRaw <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
xhairToPos
let xhairPos :: Point
xhairPos = Point -> Maybe Point -> Point
forall a. a -> Maybe a -> a
fromMaybe (Point -> Maybe Point -> Point
forall a. a -> Maybe a -> a
fromMaybe Point
originPoint Maybe Point
mpos) Maybe Point
xhairPosRaw
[Point]
bline <- case Maybe ActorId
mleader of
Just leader :: ActorId
leader -> do
Actor{Point
bpos :: Point
bpos :: Actor -> Point
bpos, LevelId
blid :: Actor -> LevelId
blid :: LevelId
blid} <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
[Point] -> m [Point]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Point] -> m [Point]) -> [Point] -> m [Point]
forall a b. (a -> b) -> a -> b
$! if LevelId
blid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
/= LevelId
drawnLevelId
then []
else [Point] -> Maybe [Point] -> [Point]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Point] -> [Point]) -> Maybe [Point] -> [Point]
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Point -> Point -> Maybe [Point]
bla Int
rXmax Int
rYmax Int
seps Point
bpos Point
xhairPos
_ -> [Point] -> m [Point]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Maybe AndPath
mpath <- m (Maybe AndPath)
-> (ActorId -> m (Maybe AndPath))
-> Maybe ActorId
-> m (Maybe AndPath)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe AndPath -> m (Maybe AndPath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AndPath
forall a. Maybe a
Nothing) (\aid :: ActorId
aid -> do
Maybe TgtAndPath
mtgtMPath <- (StateClient -> Maybe TgtAndPath) -> m (Maybe TgtAndPath)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Maybe TgtAndPath) -> m (Maybe TgtAndPath))
-> (StateClient -> Maybe TgtAndPath) -> m (Maybe TgtAndPath)
forall a b. (a -> b) -> a -> b
$ ActorId -> EnumMap ActorId TgtAndPath -> Maybe TgtAndPath
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ActorId
aid (EnumMap ActorId TgtAndPath -> Maybe TgtAndPath)
-> (StateClient -> EnumMap ActorId TgtAndPath)
-> StateClient
-> Maybe TgtAndPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateClient -> EnumMap ActorId TgtAndPath
stargetD
case Maybe TgtAndPath
mtgtMPath of
Just TgtAndPath{tapPath :: TgtAndPath -> Maybe AndPath
tapPath=tapPath :: Maybe AndPath
tapPath@(Just AndPath{Point
pathGoal :: AndPath -> Point
pathGoal :: Point
pathGoal})}
| Point
pathGoal Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
xhairPos -> Maybe AndPath -> m (Maybe AndPath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AndPath
tapPath
_ -> ActorId -> Point -> m (Maybe AndPath)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Point -> m (Maybe AndPath)
getCachePath ActorId
aid Point
xhairPos) Maybe ActorId
mleader
[(ActorId, Actor)]
assocsAtxhair <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ Point -> LevelId -> State -> [(ActorId, Actor)]
posToAidAssocs Point
xhairPos LevelId
drawnLevelId
let lpath :: [Point]
lpath = if [Point] -> Bool
forall a. [a] -> Bool
null [Point]
bline then [] else [Point] -> (AndPath -> [Point]) -> Maybe AndPath -> [Point]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] AndPath -> [Point]
pathList Maybe AndPath
mpath
shiftedBTrajectory :: [Point]
shiftedBTrajectory = case [(ActorId, Actor)]
assocsAtxhair of
(_, Actor{btrajectory :: Actor -> Maybe ([Vector], Speed)
btrajectory = Just p :: ([Vector], Speed)
p, bpos :: Actor -> Point
bpos = Point
prPos}) : _->
Point -> [Vector] -> [Point]
trajectoryToPath Point
prPos (([Vector], Speed) -> [Vector]
forall a b. (a, b) -> a
fst ([Vector], Speed)
p)
_ -> []
shiftedLine :: [Point]
shiftedLine = if [Point] -> Bool
forall a. [a] -> Bool
null [Point]
shiftedBTrajectory
then [Point]
bline
else [Point]
shiftedBTrajectory
acOnPathOrLine :: Char.Char -> Point -> ContentId TileKind
-> Color.AttrCharW32
acOnPathOrLine :: Char -> Point -> ContentId TileKind -> AttrCharW32
acOnPathOrLine !Char
ch !Point
p0 !ContentId TileKind
tile =
let fgOnPathOrLine :: Color
fgOnPathOrLine =
case ( Point -> EnumSet Point -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
ES.member Point
p0 EnumSet Point
totVisible
, TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup ContentId TileKind
tile ) of
_ | ContentId TileKind -> Bool
isUknownSpace ContentId TileKind
tile -> Color
Color.BrBlack
_ | TileSpeedup -> ContentId TileKind -> Bool
Tile.isSuspect TileSpeedup
coTileSpeedup ContentId TileKind
tile -> Color
Color.BrMagenta
(True, True) -> Color
Color.BrGreen
(True, False) -> Color
Color.BrCyan
(False, True) -> Color
Color.Green
(False, False) -> Color
Color.Cyan
in Color -> Char -> AttrCharW32
Color.attrChar2ToW32 Color
fgOnPathOrLine Char
ch
mapVTL :: forall s. (Point -> ContentId TileKind -> Color.AttrCharW32)
-> [Point]
-> FrameST s
mapVTL :: (Point -> ContentId TileKind -> AttrCharW32)
-> [Point] -> FrameST s
mapVTL f :: Point -> ContentId TileKind -> AttrCharW32
f l :: [Point]
l v :: Mutable Vector s Word32
v = do
let g :: Point -> ST s ()
g :: Point -> ST s ()
g !Point
p0 = do
let pI :: Int
pI = Point -> Int
forall a. Enum a => a -> Int
fromEnum Point
p0
tile :: Word16
tile = Vector Word16
Vector (UnboxRep (ContentId TileKind))
avector Vector Word16 -> Int -> Word16
forall a. Unbox a => Vector a -> Int -> a
U.! Int
pI
w :: Word32
w = AttrCharW32 -> Word32
Color.attrCharW32 (AttrCharW32 -> Word32) -> AttrCharW32 -> Word32
forall a b. (a -> b) -> a -> b
$ Point -> ContentId TileKind -> AttrCharW32
f Point
p0 (Word16 -> ContentId TileKind
forall c. Word16 -> ContentId c
toContentId Word16
tile)
MVector (PrimState (ST s)) Word32 -> Int -> Word32 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
VM.write MVector (PrimState (ST s)) Word32
Mutable Vector s Word32
v (Int
pI Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rXmax) Word32
w
(Point -> ST s ()) -> [Point] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Point -> ST s ()
g [Point]
l
upd :: FrameForall
upd :: FrameForall
upd = (forall s. FrameST s) -> FrameForall
FrameForall ((forall s. FrameST s) -> FrameForall)
-> (forall s. FrameST s) -> FrameForall
forall a b. (a -> b) -> a -> b
$ \v :: Mutable Vector s Word32
v -> do
(Point -> ContentId TileKind -> AttrCharW32)
-> [Point] -> FrameST s
forall s.
(Point -> ContentId TileKind -> AttrCharW32)
-> [Point] -> FrameST s
mapVTL (Char -> Point -> ContentId TileKind -> AttrCharW32
acOnPathOrLine ';') [Point]
lpath Mutable Vector s Word32
v
(Point -> ContentId TileKind -> AttrCharW32)
-> [Point] -> FrameST s
forall s.
(Point -> ContentId TileKind -> AttrCharW32)
-> [Point] -> FrameST s
mapVTL (Char -> Point -> ContentId TileKind -> AttrCharW32
acOnPathOrLine '*') [Point]
shiftedLine Mutable Vector s Word32
v
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.HighlightGreen
| Bool
dominated -> if FactionId
bfid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side
then Highlight
Color.HighlightWhite
else Highlight
Color.HighlightMagenta
| ActorId -> EnumSet ActorId -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
ES.member ActorId
aid EnumSet ActorId
sselected -> Highlight
Color.HighlightBlue
| Bool
otherwise -> Highlight
Color.HighlightNone
fg :: Color
fg | FactionId
bfid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= FactionId
side Bool -> Bool -> Bool
|| Int64
bhp Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = Color
bcolor
| Bool
otherwise =
let (hpCheckWarning :: Bool
hpCheckWarning, calmCheckWarning :: Bool
calmCheckWarning) =
UIOptions -> ActorId -> State -> (Bool, Bool)
checkWarnings UIOptions
sUIOptions ActorId
aid State
s
in if Bool
hpCheckWarning Bool -> Bool -> Bool
|| Bool
calmCheckWarning
then Color
Color.Red
else Color
bcolor
in AttrChar -> AttrCharW32
Color.attrCharToW32 (AttrChar -> AttrCharW32) -> AttrChar -> AttrCharW32
forall a b. (a -> b) -> a -> b
$ Attr -> Char -> AttrChar
Color.AttrChar $WAttr :: Color -> Highlight -> Attr
Color.Attr{..} Char
symbol
{-# INLINE viewProj #-}
viewProj :: [ActorId] -> AttrCharW32
viewProj as :: [ActorId]
as = case [ActorId]
as of
aid :: ActorId
aid : _ ->
let ActorUI{Char
bsymbol :: Char
bsymbol :: ActorUI -> Char
bsymbol, Color
bcolor :: Color
bcolor :: ActorUI -> Color
bcolor} = ActorDictUI
sactorUI ActorDictUI -> ActorId -> ActorUI
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid
bg :: Highlight
bg = Highlight
Color.HighlightNone
fg :: Color
fg = Color
bcolor
in AttrChar -> AttrCharW32
Color.attrCharToW32 (AttrChar -> AttrCharW32) -> AttrChar -> AttrCharW32
forall a b. (a -> b) -> a -> b
$ Attr -> Char -> AttrChar
Color.AttrChar $WAttr :: Color -> Highlight -> Attr
Color.Attr{..} Char
bsymbol
[] -> [Char] -> AttrCharW32
forall a. HasCallStack => [Char] -> a
error ([Char] -> AttrCharW32) -> [Char] -> AttrCharW32
forall a b. (a -> b) -> a -> b
$ "lproj not sparse" [Char] -> () -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` ()
mapVAL :: forall a s. (a -> Color.AttrCharW32) -> [(PointI, a)]
-> FrameST s
{-# INLINE mapVAL #-}
mapVAL :: (a -> AttrCharW32) -> [(Int, a)] -> FrameST s
mapVAL f :: a -> AttrCharW32
f l :: [(Int, a)]
l v :: Mutable Vector s Word32
v = do
let g :: (PointI, a) -> ST s ()
g :: (Int, a) -> ST s ()
g (!Int
pI, !a
a0) = do
let w :: Word32
w = AttrCharW32 -> Word32
Color.attrCharW32 (AttrCharW32 -> Word32) -> AttrCharW32 -> Word32
forall a b. (a -> b) -> a -> b
$ a -> AttrCharW32
f a
a0
MVector (PrimState (ST s)) Word32 -> Int -> Word32 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
VM.write MVector (PrimState (ST s)) Word32
Mutable Vector s Word32
v (Int
pI Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rXmax) Word32
w
((Int, a) -> ST s ()) -> [(Int, a)] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Int, a) -> ST s ()
g [(Int, a)]
l
upd :: FrameForall
upd :: FrameForall
upd = (forall s. FrameST s) -> FrameForall
FrameForall ((forall s. FrameST s) -> FrameForall)
-> (forall s. FrameST s) -> FrameForall
forall a b. (a -> b) -> a -> b
$ \v :: Mutable Vector s Word32
v -> do
([ActorId] -> AttrCharW32) -> [(Int, [ActorId])] -> FrameST s
forall a s. (a -> AttrCharW32) -> [(Int, a)] -> FrameST s
mapVAL [ActorId] -> AttrCharW32
viewProj (IntMap [ActorId] -> [(Int, [ActorId])]
forall a. IntMap a -> [(Int, a)]
IM.assocs (IntMap [ActorId] -> [(Int, [ActorId])])
-> IntMap [ActorId] -> [(Int, [ActorId])]
forall a b. (a -> b) -> a -> b
$ ProjectileMap -> IntMap [ActorId]
forall k a. EnumMap k a -> IntMap a
EM.enumMapToIntMap ProjectileMap
lproj) Mutable Vector s Word32
v
(ActorId -> AttrCharW32) -> [(Int, ActorId)] -> FrameST s
forall a s. (a -> AttrCharW32) -> [(Int, a)] -> FrameST s
mapVAL ActorId -> AttrCharW32
viewBig (IntMap ActorId -> [(Int, ActorId)]
forall a. IntMap a -> [(Int, a)]
IM.assocs (IntMap ActorId -> [(Int, ActorId)])
-> IntMap ActorId -> [(Int, ActorId)]
forall a b. (a -> b) -> a -> b
$ BigActorMap -> IntMap ActorId
forall k a. EnumMap k a -> IntMap a
EM.enumMapToIntMap BigActorMap
lbig) Mutable Vector s Word32
v
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
let visionMarks :: [Int]
visionMarks =
if Bool
smarkVision
then IntSet -> [Int]
IS.toList (IntSet -> [Int]) -> IntSet -> [Int]
forall a b. (a -> b) -> a -> b
$ EnumSet Point -> IntSet
forall k. EnumSet k -> IntSet
ES.enumSetToIntSet EnumSet Point
totVisible
else []
backlightVision :: Color.AttrChar -> Color.AttrChar
backlightVision :: AttrChar -> AttrChar
backlightVision ac :: AttrChar
ac = case AttrChar
ac of
Color.AttrChar (Color.Attr fg :: Color
fg _) ch :: Char
ch ->
Attr -> Char -> AttrChar
Color.AttrChar (Color -> Highlight -> Attr
Color.Attr Color
fg Highlight
Color.HighlightGrey) Char
ch
writeSquare :: Highlight -> AttrChar -> AttrChar
writeSquare !Highlight
hi (Color.AttrChar (Color.Attr fg :: Color
fg bg :: Highlight
bg) ch :: Char
ch) =
let hiUnlessLeader :: Highlight
hiUnlessLeader | Highlight
bg Highlight -> Highlight -> Bool
forall a. Eq a => a -> a -> Bool
== Highlight
Color.HighlightYellow = Highlight
bg
| Bool
otherwise = Highlight
hi
in Attr -> Char -> AttrChar
Color.AttrChar (Color -> Highlight -> Attr
Color.Attr Color
fg Highlight
hiUnlessLeader) Char
ch
turnBW :: AttrChar -> AttrChar
turnBW (Color.AttrChar _ ch :: Char
ch) = Attr -> Char -> AttrChar
Color.AttrChar Attr
Color.defAttr Char
ch
mapVL :: forall s. (Color.AttrChar -> Color.AttrChar) -> [PointI]
-> FrameST s
mapVL :: (AttrChar -> AttrChar) -> [Int] -> FrameST s
mapVL f :: AttrChar -> AttrChar
f l :: [Int]
l v :: Mutable Vector s Word32
v = do
let g :: PointI -> ST s ()
g :: Int -> ST s ()
g !Int
pI = do
Word32
w0 <- MVector (PrimState (ST s)) Word32 -> Int -> ST s Word32
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
VM.read MVector (PrimState (ST s)) Word32
Mutable Vector s Word32
v (Int
pI Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rXmax)
let w :: Word32
w = AttrCharW32 -> Word32
Color.attrCharW32 (AttrCharW32 -> Word32)
-> (Word32 -> AttrCharW32) -> Word32 -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrChar -> AttrCharW32
Color.attrCharToW32
(AttrChar -> AttrCharW32)
-> (Word32 -> AttrChar) -> Word32 -> AttrCharW32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrChar -> AttrChar
f (AttrChar -> AttrChar)
-> (Word32 -> AttrChar) -> Word32 -> AttrChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrCharW32 -> AttrChar
Color.attrCharFromW32 (AttrCharW32 -> AttrChar)
-> (Word32 -> AttrCharW32) -> Word32 -> AttrChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> AttrCharW32
Color.AttrCharW32 (Word32 -> Word32) -> Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ Word32
w0
MVector (PrimState (ST s)) Word32 -> Int -> Word32 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
VM.write MVector (PrimState (ST s)) Word32
Mutable Vector s Word32
v (Int
pI Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rXmax) Word32
w
(Int -> ST s ()) -> [Int] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Int -> ST s ()
g [Int]
l
lDungeon :: [Int]
lDungeon = [0..Int
rXmax Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
rYmax Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1]
xhairColor :: Highlight
xhairColor = if Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isJust Maybe AimMode
saimMode
then Highlight
Color.HighlightRedAim
else Highlight
Color.HighlightRed
upd :: FrameForall
upd :: FrameForall
upd = (forall s. FrameST s) -> FrameForall
FrameForall ((forall s. FrameST s) -> FrameForall)
-> (forall s. FrameST s) -> FrameForall
forall a b. (a -> b) -> a -> b
$ \v :: Mutable Vector s Word32
v -> do
Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isJust Maybe AimMode
saimMode) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ (AttrChar -> AttrChar) -> [Int] -> FrameST s
forall s. (AttrChar -> AttrChar) -> [Int] -> FrameST s
mapVL AttrChar -> AttrChar
backlightVision [Int]
visionMarks Mutable Vector s Word32
v
case Maybe Point
mtgtPos of
Nothing -> () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just p :: Point
p -> (AttrChar -> AttrChar) -> [Int] -> FrameST s
forall s. (AttrChar -> AttrChar) -> [Int] -> FrameST s
mapVL (Highlight -> AttrChar -> AttrChar
writeSquare Highlight
Color.HighlightGrey)
[Point -> Int
forall a. Enum a => a -> Int
fromEnum Point
p] Mutable Vector s Word32
v
case Maybe Point
mxhairPos of
Nothing -> () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just p :: Point
p -> (AttrChar -> AttrChar) -> [Int] -> FrameST s
forall s. (AttrChar -> AttrChar) -> [Int] -> FrameST s
mapVL (Highlight -> AttrChar -> AttrChar
writeSquare Highlight
xhairColor)
[Point -> Int
forall a. Enum a => a -> Int
fromEnum Point
p] Mutable Vector s Word32
v
Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ColorMode
dm ColorMode -> ColorMode -> Bool
forall a. Eq a => a -> a -> Bool
== ColorMode
ColorBW) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ (AttrChar -> AttrChar) -> [Int] -> FrameST s
forall s. (AttrChar -> AttrChar) -> [Int] -> FrameST s
mapVL AttrChar -> AttrChar
turnBW [Int]
lDungeon Mutable Vector s Word32
v
FrameForall -> m FrameForall
forall (m :: * -> *) a. Monad m => a -> m a
return FrameForall
upd
drawFrameStatus :: MonadClientUI m => LevelId -> m AttrLine
drawFrameStatus :: LevelId -> m AttrLine
drawFrameStatus drawnLevelId :: LevelId
drawnLevelId = do
cops :: COps
cops@COps{corule :: COps -> RuleContent
corule=RuleContent{rXmax :: RuleContent -> Int
rXmax=Int
_rXmax}} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
SessionUI{EnumSet ActorId
sselected :: EnumSet ActorId
sselected :: SessionUI -> EnumSet ActorId
sselected, Maybe AimMode
saimMode :: Maybe AimMode
saimMode :: SessionUI -> Maybe AimMode
saimMode, Int
swaitTimes :: SessionUI -> Int
swaitTimes :: Int
swaitTimes, Maybe (ItemId, CStore, Bool)
sitemSel :: SessionUI -> Maybe (ItemId, CStore, Bool)
sitemSel :: Maybe (ItemId, CStore, Bool)
sitemSel} <- m SessionUI
forall (m :: * -> *). MonadClientUI m => m SessionUI
getSession
Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
Maybe Point
xhairPos <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
xhairToPos
Maybe (Array BfsDistance)
mbfs <- m (Maybe (Array BfsDistance))
-> (ActorId -> m (Maybe (Array BfsDistance)))
-> Maybe ActorId
-> m (Maybe (Array BfsDistance))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe (Array BfsDistance) -> m (Maybe (Array BfsDistance))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Array BfsDistance)
forall a. Maybe a
Nothing) (\aid :: ActorId
aid -> Array BfsDistance -> Maybe (Array BfsDistance)
forall a. a -> Maybe a
Just (Array BfsDistance -> Maybe (Array BfsDistance))
-> m (Array BfsDistance) -> m (Maybe (Array BfsDistance))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActorId -> m (Array BfsDistance)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> m (Array BfsDistance)
getCacheBfs ActorId
aid) Maybe ActorId
mleader
(mhairDesc :: Maybe Text
mhairDesc, mxhairHPWatchfulness :: Maybe (Text, Watchfulness)
mxhairHPWatchfulness) <- m (Maybe Text, Maybe (Text, Watchfulness))
forall (m :: * -> *).
MonadClientUI m =>
m (Maybe Text, Maybe (Text, Watchfulness))
targetDescXhair
Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
drawnLevelId
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
(mblid :: Maybe LevelId
mblid, mbpos :: Maybe Point
mbpos, mbodyUI :: Maybe ActorUI
mbodyUI) <- case Maybe ActorId
mleader of
Just leader :: ActorId
leader -> do
Actor{Point
bpos :: Point
bpos :: Actor -> Point
bpos, LevelId
blid :: LevelId
blid :: Actor -> LevelId
blid} <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
ActorUI
bodyUI <- (SessionUI -> ActorUI) -> m ActorUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> ActorUI) -> m ActorUI)
-> (SessionUI -> ActorUI) -> m ActorUI
forall a b. (a -> b) -> a -> b
$ ActorId -> SessionUI -> ActorUI
getActorUI ActorId
leader
(Maybe LevelId, Maybe Point, Maybe ActorUI)
-> m (Maybe LevelId, Maybe Point, Maybe ActorUI)
forall (m :: * -> *) a. Monad m => a -> m a
return (LevelId -> Maybe LevelId
forall a. a -> Maybe a
Just LevelId
blid, Point -> Maybe Point
forall a. a -> Maybe a
Just Point
bpos, ActorUI -> Maybe ActorUI
forall a. a -> Maybe a
Just ActorUI
bodyUI)
Nothing -> (Maybe LevelId, Maybe Point, Maybe ActorUI)
-> m (Maybe LevelId, Maybe Point, Maybe ActorUI)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe LevelId
forall a. Maybe a
Nothing, Maybe Point
forall a. Maybe a
Nothing, Maybe ActorUI
forall a. Maybe a
Nothing)
let widthX :: Int
widthX = 80
widthTgt :: Int
widthTgt = 39
widthStatus :: Int
widthStatus = Int
widthX Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
widthTgt Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
arenaStatus :: AttrLine
arenaStatus = COps -> Level -> Int -> AttrLine
drawArenaStatus COps
cops Level
lvl Int
widthStatus
leaderStatusWidth :: Int
leaderStatusWidth = 23
AttrLine
leaderStatus <- Int -> m AttrLine
forall (m :: * -> *). MonadClientUI m => Int -> m AttrLine
drawLeaderStatus Int
swaitTimes
(selectedStatusWidth :: Int
selectedStatusWidth, selectedStatus :: AttrLine
selectedStatus)
<- LevelId -> Int -> EnumSet ActorId -> m (Int, AttrLine)
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Int -> EnumSet ActorId -> m (Int, AttrLine)
drawSelected LevelId
drawnLevelId (Int
widthStatus Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
leaderStatusWidth) EnumSet ActorId
sselected
let speedStatusWidth :: Int
speedStatusWidth = Int
widthStatus Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
leaderStatusWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
selectedStatusWidth
AttrLine
speedDisplay <- case Maybe ActorId
mleader of
Nothing -> AttrLine -> m AttrLine
forall (m :: * -> *) a. Monad m => a -> m a
return []
Just leader :: ActorId
leader -> do
Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
leader
[(ItemId, ItemFullKit)]
kitAssRaw <- (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)])
-> (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
forall a b. (a -> b) -> a -> b
$ ActorId -> [CStore] -> State -> [(ItemId, ItemFullKit)]
kitAssocs ActorId
leader [CStore
CEqp, CStore
COrgan]
let speed :: Int
speed = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkSpeed Skills
actorMaxSk
unknownBonus :: Bool
unknownBonus = [ItemFull] -> Bool
unknownSpeedBonus ([ItemFull] -> Bool) -> [ItemFull] -> Bool
forall a b. (a -> b) -> a -> b
$ ((ItemId, ItemFullKit) -> ItemFull)
-> [(ItemId, ItemFullKit)] -> [ItemFull]
forall a b. (a -> b) -> [a] -> [b]
map (ItemFullKit -> ItemFull
forall a b. (a, b) -> a
fst (ItemFullKit -> ItemFull)
-> ((ItemId, ItemFullKit) -> ItemFullKit)
-> (ItemId, ItemFullKit)
-> ItemFull
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ItemId, ItemFullKit) -> ItemFullKit
forall a b. (a, b) -> b
snd) [(ItemId, ItemFullKit)]
kitAssRaw
speedString :: [Char]
speedString = Int -> [Char]
displaySpeed Int
speed [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ if Bool
unknownBonus then "?" else ""
conditionBonus :: Int
conditionBonus = [ItemFullKit] -> Int
conditionSpeedBonus ([ItemFullKit] -> Int) -> [ItemFullKit] -> Int
forall a b. (a -> b) -> a -> b
$ ((ItemId, ItemFullKit) -> ItemFullKit)
-> [(ItemId, ItemFullKit)] -> [ItemFullKit]
forall a b. (a -> b) -> [a] -> [b]
map (ItemId, ItemFullKit) -> ItemFullKit
forall a b. (a, b) -> b
snd [(ItemId, ItemFullKit)]
kitAssRaw
cspeed :: Color
cspeed = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
conditionBonus 0 of
EQ -> Color
Color.White
GT -> Color
Color.Green
LT -> Color
Color.Red
AttrLine -> m AttrLine
forall (m :: * -> *) a. Monad m => a -> m a
return (AttrLine -> m AttrLine) -> AttrLine -> m AttrLine
forall a b. (a -> b) -> a -> b
$! (Char -> AttrCharW32) -> [Char] -> AttrLine
forall a b. (a -> b) -> [a] -> [b]
map (Color -> Char -> AttrCharW32
Color.attrChar2ToW32 Color
cspeed) [Char]
speedString
let speedStatus :: AttrLine
speedStatus = if AttrLine -> Int
forall a. [a] -> Int
length AttrLine
speedDisplay Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
speedStatusWidth
then []
else AttrLine
speedDisplay AttrLine -> AttrLine -> AttrLine
forall a. [a] -> [a] -> [a]
++ [AttrCharW32
Color.spaceAttrW32]
displayPathText :: Maybe Point -> Maybe Text -> Text
displayPathText mp :: Maybe Point
mp mt :: Maybe Text
mt =
let (plen :: Int
plen, llen :: Int
llen) | Just target :: Point
target <- Maybe Point
mp
, Just bfs :: Array BfsDistance
bfs <- Maybe (Array BfsDistance)
mbfs
, Just bpos :: Point
bpos <- Maybe Point
mbpos
, Maybe LevelId
mblid Maybe LevelId -> Maybe LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId -> Maybe LevelId
forall a. a -> Maybe a
Just LevelId
drawnLevelId
= ( Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 0 (Array BfsDistance -> Point -> Maybe Int
accessBfs Array BfsDistance
bfs Point
target)
, Point -> Point -> Int
chessDist Point
bpos Point
target )
| Bool
otherwise = (0, 0)
pText :: Text
pText | Int
plen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = ""
| Bool
otherwise = "p" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
plen
lText :: Text
lText | Int
llen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = ""
| Bool
otherwise = "l" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
llen
text :: Text
text = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (Text
pText Text -> Text -> Text
<+> Text
lText) Maybe Text
mt
in if Text -> Bool
T.null Text
text then "" else " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
text
pathCsr :: Text
pathCsr = Maybe Point -> Maybe Text -> Text
displayPathText Maybe Point
xhairPos ((Text, Watchfulness) -> Text
forall a b. (a, b) -> a
fst ((Text, Watchfulness) -> Text)
-> Maybe (Text, Watchfulness) -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Text, Watchfulness)
mxhairHPWatchfulness)
trimTgtDesc :: Int -> Text -> Text
trimTgtDesc n :: Int
n t :: Text
t = Bool -> Text -> Text
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not (Text -> Bool
T.null Text
t) Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 2 Bool -> (Text, Int) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (Text
t, Int
n)) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
if Text -> Int
T.length Text
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n then Text
t else Int -> Text -> Text
T.take (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- 3) Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "..."
widthXhairOrItem :: Int
widthXhairOrItem = Int
widthTgt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
pathCsr Int -> Int -> Int
forall a. Num a => a -> a -> a
- 8
nMember :: Part
nMember = Int -> Part
MU.Ord (Int -> Part) -> Int -> Part
forall a b. (a -> b) -> a -> b
$ 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall a. Num a => [a] -> a
sum (EnumMap (ContentId ItemKind) Int -> [Int]
forall k a. EnumMap k a -> [a]
EM.elems (EnumMap (ContentId ItemKind) Int -> [Int])
-> EnumMap (ContentId ItemKind) Int -> [Int]
forall a b. (a -> b) -> a -> b
$ Faction -> EnumMap (ContentId ItemKind) Int
gvictims Faction
fact)
fallback :: Text
fallback = if Player -> LeaderMode
MK.fleaderMode (Faction -> Player
gplayer Faction
fact) LeaderMode -> LeaderMode -> Bool
forall a. Eq a => a -> a -> Bool
== LeaderMode
MK.LeaderNull
then "This faction never picks a leader"
else [Part] -> Text
makePhrase
["Waiting for", Part
nMember, "team member to spawn"]
leaderName :: ActorUI -> Text
leaderName bUI :: ActorUI
bUI = Int -> Text -> Text
trimTgtDesc (Int
widthTgt Int -> Int -> Int
forall a. Num a => a -> a -> a
- 8) (ActorUI -> Text
bname ActorUI
bUI)
leaderBlurbLong :: Text
leaderBlurbLong = Text -> (ActorUI -> Text) -> Maybe ActorUI -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
fallback (\bUI :: ActorUI
bUI ->
"Leader:" Text -> Text -> Text
<+> ActorUI -> Text
leaderName ActorUI
bUI) Maybe ActorUI
mbodyUI
leaderBlurbShort :: Text
leaderBlurbShort = Text -> (ActorUI -> Text) -> Maybe ActorUI -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
fallback ActorUI -> Text
leaderName Maybe ActorUI
mbodyUI
[(ActorId, Actor)]
ours <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ FactionId -> State -> [(ActorId, Actor)]
fidActorNotProjGlobalAssocs FactionId
side
let na :: Int
na = [(ActorId, Actor)] -> Int
forall a. [a] -> Int
length [(ActorId, Actor)]
ours
nl :: Int
nl = EnumSet LevelId -> Int
forall k. EnumSet k -> Int
ES.size (EnumSet LevelId -> Int) -> EnumSet LevelId -> Int
forall a b. (a -> b) -> a -> b
$ [LevelId] -> EnumSet LevelId
forall k. Enum k => [k] -> EnumSet k
ES.fromList ([LevelId] -> EnumSet LevelId) -> [LevelId] -> EnumSet LevelId
forall a b. (a -> b) -> a -> b
$ ((ActorId, Actor) -> LevelId) -> [(ActorId, Actor)] -> [LevelId]
forall a b. (a -> b) -> [a] -> [b]
map (Actor -> LevelId
blid (Actor -> LevelId)
-> ((ActorId, Actor) -> Actor) -> (ActorId, Actor) -> LevelId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> Actor
forall a b. (a, b) -> b
snd) [(ActorId, Actor)]
ours
ns :: Int
ns = ItemBag -> Int
forall k a. EnumMap k a -> Int
EM.size (ItemBag -> Int) -> ItemBag -> Int
forall a b. (a -> b) -> a -> b
$ Faction -> ItemBag
gsha Faction
fact
teamBlurb :: AttrLine
teamBlurb = Text -> AttrLine
textToAL (Text -> AttrLine) -> Text -> AttrLine
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
trimTgtDesc Int
widthTgt (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
[Part] -> Text
makePhrase [ "Team:"
, Int -> Part -> Part
MU.CarWs Int
na "actor", "on"
, Int -> Part -> Part
MU.CarWs Int
nl "level" Part -> Part -> Part
forall a. Semigroup a => a -> a -> a
<> ","
, "stash", Int -> Part
MU.Car Int
ns ]
markSleepTgtDesc :: Text -> AttrLine
markSleepTgtDesc
| ((Text, Watchfulness) -> Watchfulness
forall a b. (a, b) -> b
snd ((Text, Watchfulness) -> Watchfulness)
-> Maybe (Text, Watchfulness) -> Maybe Watchfulness
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Text, Watchfulness)
mxhairHPWatchfulness) Maybe Watchfulness -> Maybe Watchfulness -> Bool
forall a. Eq a => a -> a -> Bool
/= Watchfulness -> Maybe Watchfulness
forall a. a -> Maybe a
Just Watchfulness
WSleep = Text -> AttrLine
textToAL
| Bool
otherwise = Color -> Text -> AttrLine
textFgToAL Color
Color.Green
xhairBlurb :: AttrLine
xhairBlurb =
AttrLine -> (Text -> AttrLine) -> Maybe Text -> AttrLine
forall b a. b -> (a -> b) -> Maybe a -> b
maybe AttrLine
teamBlurb (\t :: Text
t ->
Text -> AttrLine
textToAL (if Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isJust Maybe AimMode
saimMode then "x-hair>" else "X-hair:")
AttrLine -> AttrLine -> AttrLine
<+:> Text -> AttrLine
markSleepTgtDesc (Int -> Text -> Text
trimTgtDesc Int
widthXhairOrItem Text
t))
Maybe Text
mhairDesc
tgtOrItem :: m (AttrLine, Text)
tgtOrItem
| Just (iid :: ItemId
iid, fromCStore :: CStore
fromCStore, _) <- Maybe (ItemId, CStore, Bool)
sitemSel
, Just leader :: ActorId
leader <- Maybe ActorId
mleader
= do
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
ItemBag
bag <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ Actor -> CStore -> State -> ItemBag
getBodyStoreBag Actor
b CStore
fromCStore
case ItemId
iid ItemId -> ItemBag -> Maybe ItemQuant
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` ItemBag
bag of
Nothing -> (AttrLine, Text) -> m (AttrLine, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (AttrLine
xhairBlurb, Text
pathCsr)
Just kit :: ItemQuant
kit@(k :: Int
k, _) -> do
Time
localTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime (Actor -> LevelId
blid Actor
b)
ItemFull
itemFull <- (State -> ItemFull) -> m ItemFull
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemFull) -> m ItemFull)
-> (State -> ItemFull) -> m ItemFull
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemFull
itemToFull ItemId
iid
FactionDict
factionD <- (State -> FactionDict) -> m FactionDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
let (name :: Part
name, powers :: Part
powers) =
FactionId
-> FactionDict -> Time -> ItemFull -> ItemQuant -> (Part, Part)
partItem (Actor -> FactionId
bfid Actor
b) FactionDict
factionD Time
localTime ItemFull
itemFull ItemQuant
kit
t :: Text
t = [Part] -> Text
makePhrase [Int -> Part -> Part
MU.Car1Ws Int
k Part
name, Part
powers]
(AttrLine, Text) -> m (AttrLine, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> AttrLine
textToAL (Text -> AttrLine) -> Text -> AttrLine
forall a b. (a -> b) -> a -> b
$ "Item:" Text -> Text -> Text
<+> Int -> Text -> Text
trimTgtDesc (Int
widthTgt Int -> Int -> Int
forall a. Num a => a -> a -> a
- 6) Text
t, "")
| Bool
otherwise =
(AttrLine, Text) -> m (AttrLine, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (AttrLine
xhairBlurb, Text
pathCsr)
(xhairLine :: AttrLine
xhairLine, pathXhairOrNull :: Text
pathXhairOrNull) <- m (AttrLine, Text)
tgtOrItem
AttrLine
damageStatus <- m AttrLine
-> (ActorId -> m AttrLine) -> Maybe ActorId -> m AttrLine
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (AttrLine -> m AttrLine
forall (m :: * -> *) a. Monad m => a -> m a
return []) (Int -> ActorId -> m AttrLine
forall (m :: * -> *).
MonadClientUI m =>
Int -> ActorId -> m AttrLine
drawLeaderDamage Int
widthTgt) Maybe ActorId
mleader
let damageStatusWidth :: Int
damageStatusWidth = AttrLine -> Int
forall a. [a] -> Int
length AttrLine
damageStatus
withForLeader :: Int
withForLeader = Int
widthTgt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
damageStatusWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
leaderBottom :: Text
leaderBottom =
if | Text -> Int
T.length Text
leaderBlurbShort Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
withForLeader -> ""
| Text -> Int
T.length Text
leaderBlurbLong Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
withForLeader -> Text
leaderBlurbShort
| Bool
otherwise -> Text
leaderBlurbLong
damageGap :: AttrLine
damageGap = Int -> AttrLine
emptyAttrLine
(Int -> AttrLine) -> Int -> AttrLine
forall a b. (a -> b) -> a -> b
$ Int
widthTgt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
damageStatusWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
leaderBottom
xhairGap :: AttrLine
xhairGap = Int -> AttrLine
emptyAttrLine (Int
widthTgt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
pathXhairOrNull
Int -> Int -> Int
forall a. Num a => a -> a -> a
- AttrLine -> Int
forall a. [a] -> Int
length AttrLine
xhairLine)
xhairStatus :: AttrLine
xhairStatus = AttrLine
xhairLine AttrLine -> AttrLine -> AttrLine
forall a. [a] -> [a] -> [a]
++ AttrLine
xhairGap AttrLine -> AttrLine -> AttrLine
forall a. [a] -> [a] -> [a]
++ Text -> AttrLine
textToAL Text
pathXhairOrNull
selectedGap :: AttrLine
selectedGap = Int -> AttrLine
emptyAttrLine (Int
widthStatus Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
leaderStatusWidth
Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
selectedStatusWidth
Int -> Int -> Int
forall a. Num a => a -> a -> a
- AttrLine -> Int
forall a. [a] -> Int
length AttrLine
speedStatus)
status :: AttrLine
status = AttrLine
arenaStatus
AttrLine -> AttrLine -> AttrLine
<+:> AttrLine
xhairStatus
AttrLine -> AttrLine -> AttrLine
forall a. Semigroup a => a -> a -> a
<> AttrLine
selectedStatus AttrLine -> AttrLine -> AttrLine
forall a. [a] -> [a] -> [a]
++ AttrLine
selectedGap AttrLine -> AttrLine -> AttrLine
forall a. [a] -> [a] -> [a]
++ AttrLine
speedStatus AttrLine -> AttrLine -> AttrLine
forall a. [a] -> [a] -> [a]
++ AttrLine
leaderStatus
AttrLine -> AttrLine -> AttrLine
<+:> (Text -> AttrLine
textToAL Text
leaderBottom AttrLine -> AttrLine -> AttrLine
forall a. [a] -> [a] -> [a]
++ AttrLine
damageGap AttrLine -> AttrLine -> AttrLine
forall a. [a] -> [a] -> [a]
++ AttrLine
damageStatus)
AttrLine -> m AttrLine
forall (m :: * -> *) a. Monad m => a -> m a
return
#ifdef WITH_EXPENSIVE_ASSERTIONS
$ assert (length status == 2 * _rXmax
`blame` map Color.charFromW32 status)
#endif
AttrLine
status
drawHudFrame :: MonadClientUI m => ColorMode -> LevelId -> m PreFrame
drawHudFrame :: ColorMode -> LevelId -> m PreFrame
drawHudFrame dm :: ColorMode
dm drawnLevelId :: LevelId
drawnLevelId = do
Vector Word32
baseTerrain <- LevelId -> m (Vector Word32)
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> m (Vector Word32)
drawFrameTerrain LevelId
drawnLevelId
FrameForall
updContent <- LevelId -> m FrameForall
forall (m :: * -> *). MonadClientUI m => LevelId -> m FrameForall
drawFrameContent LevelId
drawnLevelId
FrameForall
updPath <- LevelId -> m FrameForall
forall (m :: * -> *). MonadClientUI m => LevelId -> m FrameForall
drawFramePath LevelId
drawnLevelId
FrameForall
updActor <- LevelId -> m FrameForall
forall (m :: * -> *). MonadClientUI m => LevelId -> m FrameForall
drawFrameActor LevelId
drawnLevelId
FrameForall
updExtra <- ColorMode -> LevelId -> m FrameForall
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> LevelId -> m FrameForall
drawFrameExtra ColorMode
dm LevelId
drawnLevelId
let upd :: FrameForall
upd = (forall s. FrameST s) -> FrameForall
FrameForall ((forall s. FrameST s) -> FrameForall)
-> (forall s. FrameST s) -> FrameForall
forall a b. (a -> b) -> a -> b
$ \v :: Mutable Vector s Word32
v -> do
FrameForall -> FrameST s
FrameForall -> forall s. FrameST s
unFrameForall FrameForall
updContent Mutable Vector s Word32
v
Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Char]
frontendName [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== "vty") (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ FrameForall -> FrameST s
FrameForall -> forall s. FrameST s
unFrameForall FrameForall
updPath Mutable Vector s Word32
v
FrameForall -> FrameST s
FrameForall -> forall s. FrameST s
unFrameForall FrameForall
updActor Mutable Vector s Word32
v
FrameForall -> FrameST s
FrameForall -> forall s. FrameST s
unFrameForall FrameForall
updExtra Mutable Vector s Word32
v
PreFrame -> m PreFrame
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector Word32
baseTerrain, FrameForall
upd)
drawArenaStatus :: COps -> Level -> Int -> AttrLine
drawArenaStatus :: COps -> Level -> Int -> AttrLine
drawArenaStatus COps{ContentData CaveKind
cocave :: COps -> ContentData CaveKind
cocave :: ContentData CaveKind
cocave}
Level{ContentId CaveKind
lkind :: Level -> ContentId CaveKind
lkind :: ContentId CaveKind
lkind, ldepth :: Level -> AbsDepth
ldepth=Dice.AbsDepth ld :: Int
ld, Int
lseen :: Level -> Int
lseen :: Int
lseen, Int
lexpl :: Level -> Int
lexpl :: Int
lexpl}
width :: Int
width =
let ck :: CaveKind
ck = ContentData CaveKind -> ContentId CaveKind -> CaveKind
forall a. ContentData a -> ContentId a -> a
okind ContentData CaveKind
cocave ContentId CaveKind
lkind
seenN :: Int
seenN = 100 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
lseen Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 1 Int
lexpl
seenTxt :: Text
seenTxt | Int
seenN Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 100 = "all"
| Bool
otherwise = Int -> Char -> Text -> Text
T.justifyLeft 3 ' ' (Int -> Text
forall a. Show a => a -> Text
tshow Int
seenN Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "%")
lvlN :: Text
lvlN = Int -> Char -> Text -> Text
T.justifyLeft 2 ' ' (Int -> Text
forall a. Show a => a -> Text
tshow Int
ld)
seenStatus :: Text
seenStatus = "[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
seenTxt Text -> Text -> Text
<+> "seen]"
in Text -> AttrLine
textToAL (Text -> AttrLine) -> Text -> AttrLine
forall a b. (a -> b) -> a -> b
$ Int -> Char -> Text -> Text
T.justifyLeft Int
width ' '
(Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.take 29 (Text
lvlN Text -> Text -> Text
<+> Int -> Char -> Text -> Text
T.justifyLeft 26 ' ' (CaveKind -> Text
cname CaveKind
ck))
Text -> Text -> Text
<+> Text
seenStatus
drawLeaderStatus :: MonadClientUI m => Int -> m AttrLine
drawLeaderStatus :: Int -> m AttrLine
drawLeaderStatus waitT :: Int
waitT = do
Time
time <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Time
stime
let calmHeaderText :: [Char]
calmHeaderText = "Calm"
hpHeaderText :: [Char]
hpHeaderText = "HP"
slashes :: [[Char]]
slashes = ["/", "|", "\\", "|"]
waitGlobal :: Int
waitGlobal = Time -> Time -> Int
timeFit Time
time Time
timeTurn
UIOptions
sUIOptions <- (SessionUI -> UIOptions) -> m UIOptions
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> UIOptions
sUIOptions
Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
case Maybe ActorId
mleader of
Just leader :: ActorId
leader -> do
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
leader
(hpCheckWarning :: Bool
hpCheckWarning, calmCheckWarning :: Bool
calmCheckWarning)
<- (State -> (Bool, Bool)) -> m (Bool, Bool)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> (Bool, Bool)) -> m (Bool, Bool))
-> (State -> (Bool, Bool)) -> m (Bool, Bool)
forall a b. (a -> b) -> a -> b
$ UIOptions -> ActorId -> State -> (Bool, Bool)
checkWarnings UIOptions
sUIOptions ActorId
leader
Bool
bdark <- (State -> Bool) -> m Bool
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ \s :: State
s -> Bool -> Bool
not (Actor -> State -> Bool
actorInAmbient Actor
b State
s)
let showTrunc :: a -> [Char]
showTrunc x :: a
x = let t :: [Char]
t = a -> [Char]
forall a. Show a => a -> [Char]
show a
x
in if [Char] -> Int
forall a. [a] -> Int
length [Char]
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 3
then if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then "***" else "---"
else [Char]
t
waitSlash :: Int
waitSlash | Actor -> Watchfulness
bwatch Actor
b Watchfulness -> Watchfulness -> Bool
forall a. Eq a => a -> a -> Bool
== Watchfulness
WSleep = Int
waitGlobal
| Bool
otherwise = Int -> Int
forall a. Num a => a -> a
abs Int
waitT
slashPick :: [Char]
slashPick = [[Char]]
slashes [[Char]] -> Int -> [Char]
forall a. [a] -> Int -> a
!! (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 Int
waitSlash Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` [[Char]] -> Int
forall a. [a] -> Int
length [[Char]]
slashes)
addColor :: Color -> [Char] -> AttrLine
addColor c :: Color
c = (Char -> AttrCharW32) -> [Char] -> AttrLine
forall a b. (a -> b) -> [a] -> [b]
map (Color -> Char -> AttrCharW32
Color.attrChar2ToW32 Color
c)
checkDelta :: ResDelta -> [Char] -> AttrLine
checkDelta ResDelta{..}
| (Int64, Int64) -> Int64
forall a b. (a, b) -> a
fst (Int64, Int64)
resCurrentTurn Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< 0 Bool -> Bool -> Bool
|| (Int64, Int64) -> Int64
forall a b. (a, b) -> a
fst (Int64, Int64)
resPreviousTurn Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< 0
= Color -> [Char] -> AttrLine
addColor Color
Color.BrRed
| (Int64, Int64) -> Int64
forall a b. (a, b) -> b
snd (Int64, Int64)
resCurrentTurn Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
|| (Int64, Int64) -> Int64
forall a b. (a, b) -> b
snd (Int64, Int64)
resPreviousTurn Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> 0
= Color -> [Char] -> AttrLine
addColor Color
Color.BrGreen
| Bool
otherwise = [Char] -> AttrLine
stringToAL
checkSleep :: Actor -> ResDelta -> [Char] -> AttrLine
checkSleep body :: Actor
body resDelta :: ResDelta
resDelta
| Actor -> Watchfulness
bwatch Actor
body Watchfulness -> Watchfulness -> Bool
forall a. Eq a => a -> a -> Bool
== Watchfulness
WSleep = Color -> [Char] -> AttrLine
addColor Color
Color.Green
| Bool
otherwise = ResDelta -> [Char] -> AttrLine
checkDelta ResDelta
resDelta
calmAddAttr :: [Char] -> AttrLine
calmAddAttr = Actor -> ResDelta -> [Char] -> AttrLine
checkSleep Actor
b (ResDelta -> [Char] -> AttrLine) -> ResDelta -> [Char] -> AttrLine
forall a b. (a -> b) -> a -> b
$ Actor -> ResDelta
bcalmDelta Actor
b
darkPick :: [Char]
darkPick | Bool
bdark = "."
| Bool
otherwise = ":"
calmHeader :: AttrLine
calmHeader = [Char] -> AttrLine
calmAddAttr ([Char] -> AttrLine) -> [Char] -> AttrLine
forall a b. (a -> b) -> a -> b
$ [Char]
calmHeaderText [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
darkPick
calmText :: [Char]
calmText = Int64 -> [Char]
forall a. (Show a, Ord a, Num a) => a -> [Char]
showTrunc (Actor -> Int64
bcalm Actor
b Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`divUp` Int64
oneM)
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> (if Bool
bdark then [Char]
slashPick else "/")
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. (Show a, Ord a, Num a) => a -> [Char]
showTrunc (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMaxCalm
Skills
actorMaxSk)
bracePick :: [Char]
bracePick | Actor -> Bool
actorWaits Actor
b = "}"
| Bool
otherwise = ":"
hpAddAttr :: [Char] -> AttrLine
hpAddAttr = ResDelta -> [Char] -> AttrLine
checkDelta (ResDelta -> [Char] -> AttrLine) -> ResDelta -> [Char] -> AttrLine
forall a b. (a -> b) -> a -> b
$ Actor -> ResDelta
bhpDelta Actor
b
hpHeader :: AttrLine
hpHeader = [Char] -> AttrLine
hpAddAttr ([Char] -> AttrLine) -> [Char] -> AttrLine
forall a b. (a -> b) -> a -> b
$ [Char]
hpHeaderText [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
bracePick
hpText :: [Char]
hpText = Int64 -> [Char]
forall a. (Show a, Ord a, Num a) => a -> [Char]
showTrunc (Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`divUp` Int64
oneM)
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> (if Bool -> Bool
not Bool
bdark then [Char]
slashPick else "/")
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. (Show a, Ord a, Num a) => a -> [Char]
showTrunc (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMaxHP
Skills
actorMaxSk)
justifyRight :: Int -> [Char] -> [Char]
justifyRight n :: Int
n t :: [Char]
t = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Char] -> Int
forall a. [a] -> Int
length [Char]
t) ' ' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
t
colorWarning :: Bool -> [Char] -> AttrLine
colorWarning w :: Bool
w = if Bool
w then Color -> [Char] -> AttrLine
addColor Color
Color.Red else [Char] -> AttrLine
stringToAL
AttrLine -> m AttrLine
forall (m :: * -> *) a. Monad m => a -> m a
return (AttrLine -> m AttrLine) -> AttrLine -> m AttrLine
forall a b. (a -> b) -> a -> b
$! AttrLine
calmHeader
AttrLine -> AttrLine -> AttrLine
forall a. Semigroup a => a -> a -> a
<> Bool -> [Char] -> AttrLine
colorWarning Bool
calmCheckWarning (Int -> [Char] -> [Char]
justifyRight 7 [Char]
calmText)
AttrLine -> AttrLine -> AttrLine
<+:> AttrLine
hpHeader
AttrLine -> AttrLine -> AttrLine
forall a. Semigroup a => a -> a -> a
<> Bool -> [Char] -> AttrLine
colorWarning Bool
hpCheckWarning (Int -> [Char] -> [Char]
justifyRight 7 [Char]
hpText)
Nothing -> do
let slashPick :: [Char]
slashPick = [[Char]]
slashes [[Char]] -> Int -> [Char]
forall a. [a] -> Int -> a
!! (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 Int
waitGlobal Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` [[Char]] -> Int
forall a. [a] -> Int
length [[Char]]
slashes)
AttrLine -> m AttrLine
forall (m :: * -> *) a. Monad m => a -> m a
return (AttrLine -> m AttrLine) -> AttrLine -> m AttrLine
forall a b. (a -> b) -> a -> b
$! [Char] -> AttrLine
stringToAL ([Char]
calmHeaderText [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ": --" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
slashPick [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "--")
AttrLine -> AttrLine -> AttrLine
<+:> [Char] -> AttrLine
stringToAL ([Char]
hpHeaderText [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> ": --/--")
drawLeaderDamage :: MonadClientUI m => Int -> ActorId -> m AttrLine
drawLeaderDamage :: Int -> ActorId -> m AttrLine
drawLeaderDamage width :: Int
width leader :: ActorId
leader = do
[(ItemId, ItemFullKit)]
kitAssRaw <- (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)])
-> (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
forall a b. (a -> b) -> a -> b
$ ActorId -> [CStore] -> State -> [(ItemId, ItemFullKit)]
kitAssocs ActorId
leader [CStore
CEqp, CStore
COrgan]
Skills
actorSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
leader
let hasTimeout :: ItemFull -> Bool
hasTimeout itemFull :: ItemFull
itemFull =
let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
timeout :: Int
timeout = AspectRecord -> Int
IA.aTimeout AspectRecord
arItem
in Int
timeout Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
hasEffect :: ItemFull -> Bool
hasEffect itemFull :: ItemFull
itemFull =
(Effect -> Bool) -> [Effect] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Effect -> Bool
IK.forApplyEffect ([Effect] -> Bool) -> [Effect] -> Bool
forall a b. (a -> b) -> a -> b
$ ItemKind -> [Effect]
IK.ieffects (ItemKind -> [Effect]) -> ItemKind -> [Effect]
forall a b. (a -> b) -> a -> b
$ ItemFull -> ItemKind
itemKind ItemFull
itemFull
ppDice :: (Int, ItemFullKit) -> [(Bool, AttrLine)]
ppDice :: (Int, ItemFullKit) -> [(Bool, AttrLine)]
ppDice (nch :: Int
nch, (itemFull :: ItemFull
itemFull, (k :: Int
k, _))) =
let tdice :: [Char]
tdice = Dice -> [Char]
forall a. Show a => a -> [Char]
show (Dice -> [Char]) -> Dice -> [Char]
forall a b. (a -> b) -> a -> b
$ ItemKind -> Dice
IK.idamage (ItemKind -> Dice) -> ItemKind -> Dice
forall a b. (a -> b) -> a -> b
$ ItemFull -> ItemKind
itemKind ItemFull
itemFull
tdiceEffect :: [Char]
tdiceEffect = if ItemFull -> Bool
hasEffect ItemFull
itemFull
then (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
Char.toUpper [Char]
tdice
else [Char]
tdice
in if ItemFull -> Bool
hasTimeout ItemFull
itemFull
then Int -> (Bool, AttrLine) -> [(Bool, AttrLine)]
forall a. Int -> a -> [a]
replicate (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nch)
(Bool
False, (Char -> AttrCharW32) -> [Char] -> AttrLine
forall a b. (a -> b) -> [a] -> [b]
map (Color -> Char -> AttrCharW32
Color.attrChar2ToW32 Color
Color.Cyan) [Char]
tdiceEffect)
[(Bool, AttrLine)] -> [(Bool, AttrLine)] -> [(Bool, AttrLine)]
forall a. [a] -> [a] -> [a]
++ Int -> (Bool, AttrLine) -> [(Bool, AttrLine)]
forall a. Int -> a -> [a]
replicate Int
nch
(Bool
True, (Char -> AttrCharW32) -> [Char] -> AttrLine
forall a b. (a -> b) -> [a] -> [b]
map (Color -> Char -> AttrCharW32
Color.attrChar2ToW32 Color
Color.BrCyan) [Char]
tdiceEffect)
else [(Bool
True, (Char -> AttrCharW32) -> [Char] -> AttrLine
forall a b. (a -> b) -> [a] -> [b]
map (Color -> Char -> AttrCharW32
Color.attrChar2ToW32 Color
Color.BrBlue) [Char]
tdiceEffect)]
lbonus :: AttrLine
lbonus :: AttrLine
lbonus =
let bonusRaw :: Int
bonusRaw = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkHurtMelee Skills
actorMaxSk
bonus :: Int
bonus = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min 200 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (-200) Int
bonusRaw
unknownBonus :: Bool
unknownBonus = [ItemFull] -> Bool
unknownMeleeBonus ([ItemFull] -> Bool) -> [ItemFull] -> Bool
forall a b. (a -> b) -> a -> b
$ ((ItemId, ItemFullKit) -> ItemFull)
-> [(ItemId, ItemFullKit)] -> [ItemFull]
forall a b. (a -> b) -> [a] -> [b]
map (ItemFullKit -> ItemFull
forall a b. (a, b) -> a
fst (ItemFullKit -> ItemFull)
-> ((ItemId, ItemFullKit) -> ItemFullKit)
-> (ItemId, ItemFullKit)
-> ItemFull
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ItemId, ItemFullKit) -> ItemFullKit
forall a b. (a, b) -> b
snd) [(ItemId, ItemFullKit)]
kitAssRaw
tbonus :: [Char]
tbonus = if Int
bonus Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0
then if Bool
unknownBonus then "+?" else ""
else (if Int
bonus Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then "+" else "")
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
bonus
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> (if Int
bonus Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
bonusRaw then "$" else "")
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> if Bool
unknownBonus then "%?" else "%"
conditionBonus :: Int
conditionBonus = [ItemFullKit] -> Int
conditionMeleeBonus ([ItemFullKit] -> Int) -> [ItemFullKit] -> Int
forall a b. (a -> b) -> a -> b
$ ((ItemId, ItemFullKit) -> ItemFullKit)
-> [(ItemId, ItemFullKit)] -> [ItemFullKit]
forall a b. (a -> b) -> [a] -> [b]
map (ItemId, ItemFullKit) -> ItemFullKit
forall a b. (a, b) -> b
snd [(ItemId, ItemFullKit)]
kitAssRaw
cbonus :: Color
cbonus = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
conditionBonus 0 of
EQ -> Color
Color.White
GT -> Color
Color.Green
LT -> Color
Color.Red
in (Char -> AttrCharW32) -> [Char] -> AttrLine
forall a b. (a -> b) -> [a] -> [b]
map (Color -> Char -> AttrCharW32
Color.attrChar2ToW32 Color
cbonus) [Char]
tbonus
let kitAssOnlyWeapons :: [(ItemId, ItemFullKit)]
kitAssOnlyWeapons =
((ItemId, ItemFullKit) -> Bool)
-> [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Meleeable
(AspectRecord -> Bool)
-> ((ItemId, ItemFullKit) -> AspectRecord)
-> (ItemId, ItemFullKit)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemFull -> AspectRecord
aspectRecordFull (ItemFull -> AspectRecord)
-> ((ItemId, ItemFullKit) -> ItemFull)
-> (ItemId, ItemFullKit)
-> AspectRecord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemFullKit -> ItemFull
forall a b. (a, b) -> a
fst (ItemFullKit -> ItemFull)
-> ((ItemId, ItemFullKit) -> ItemFullKit)
-> (ItemId, ItemFullKit)
-> ItemFull
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ItemId, ItemFullKit) -> ItemFullKit
forall a b. (a, b) -> b
snd) [(ItemId, ItemFullKit)]
kitAssRaw
DiscoveryBenefit
discoBenefit <- (StateClient -> DiscoveryBenefit) -> m DiscoveryBenefit
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> DiscoveryBenefit
sdiscoBenefit
[(Int, ItemFullKit)]
strongest <- ((Double, (Int, (ItemId, ItemFullKit))) -> (Int, ItemFullKit))
-> [(Double, (Int, (ItemId, ItemFullKit)))] -> [(Int, ItemFullKit)]
forall a b. (a -> b) -> [a] -> [b]
map (((ItemId, ItemFullKit) -> ItemFullKit)
-> (Int, (ItemId, ItemFullKit)) -> (Int, ItemFullKit)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (ItemId, ItemFullKit) -> ItemFullKit
forall a b. (a, b) -> b
snd ((Int, (ItemId, ItemFullKit)) -> (Int, ItemFullKit))
-> ((Double, (Int, (ItemId, ItemFullKit)))
-> (Int, (ItemId, ItemFullKit)))
-> (Double, (Int, (ItemId, ItemFullKit)))
-> (Int, ItemFullKit)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, (Int, (ItemId, ItemFullKit)))
-> (Int, (ItemId, ItemFullKit))
forall a b. (a, b) -> b
snd) ([(Double, (Int, (ItemId, ItemFullKit)))] -> [(Int, ItemFullKit)])
-> m [(Double, (Int, (ItemId, ItemFullKit)))]
-> m [(Int, ItemFullKit)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Bool
-> Maybe DiscoveryBenefit
-> [(ItemId, ItemFullKit)]
-> Skills
-> ActorId
-> m [(Double, (Int, (ItemId, ItemFullKit)))]
forall (m :: * -> *).
MonadStateRead m =>
Bool
-> Maybe DiscoveryBenefit
-> [(ItemId, ItemFullKit)]
-> Skills
-> ActorId
-> m [(Double, (Int, (ItemId, ItemFullKit)))]
pickWeaponM Bool
True (DiscoveryBenefit -> Maybe DiscoveryBenefit
forall a. a -> Maybe a
Just DiscoveryBenefit
discoBenefit) [(ItemId, ItemFullKit)]
kitAssOnlyWeapons Skills
actorSk ActorId
leader
let (lT :: [(Int, ItemFullKit)]
lT, lRatherNoT :: [(Int, ItemFullKit)]
lRatherNoT) = ((Int, ItemFullKit) -> Bool)
-> [(Int, ItemFullKit)]
-> ([(Int, ItemFullKit)], [(Int, ItemFullKit)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (ItemFull -> Bool
hasTimeout (ItemFull -> Bool)
-> ((Int, ItemFullKit) -> ItemFull) -> (Int, ItemFullKit) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemFullKit -> ItemFull
forall a b. (a, b) -> a
fst (ItemFullKit -> ItemFull)
-> ((Int, ItemFullKit) -> ItemFullKit)
-> (Int, ItemFullKit)
-> ItemFull
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, ItemFullKit) -> ItemFullKit
forall a b. (a, b) -> b
snd) [(Int, ItemFullKit)]
strongest
strongestToDisplay :: [(Int, ItemFullKit)]
strongestToDisplay = [(Int, ItemFullKit)]
lT [(Int, ItemFullKit)]
-> [(Int, ItemFullKit)] -> [(Int, ItemFullKit)]
forall a. [a] -> [a] -> [a]
++ Int -> [(Int, ItemFullKit)] -> [(Int, ItemFullKit)]
forall a. Int -> [a] -> [a]
take 1 [(Int, ItemFullKit)]
lRatherNoT
lToDisplay :: [(Bool, AttrLine)]
lToDisplay = ((Int, ItemFullKit) -> [(Bool, AttrLine)])
-> [(Int, ItemFullKit)] -> [(Bool, AttrLine)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int, ItemFullKit) -> [(Bool, AttrLine)]
ppDice [(Int, ItemFullKit)]
strongestToDisplay
(ldischarged :: [(Bool, AttrLine)]
ldischarged, lrest :: [(Bool, AttrLine)]
lrest) = ((Bool, AttrLine) -> Bool)
-> [(Bool, AttrLine)] -> ([(Bool, AttrLine)], [(Bool, AttrLine)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Bool -> Bool
not (Bool -> Bool)
-> ((Bool, AttrLine) -> Bool) -> (Bool, AttrLine) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool, AttrLine) -> Bool
forall a b. (a, b) -> a
fst) [(Bool, AttrLine)]
lToDisplay
lWithBonus :: [AttrLine]
lWithBonus = case ((Bool, AttrLine) -> AttrLine) -> [(Bool, AttrLine)] -> [AttrLine]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, AttrLine) -> AttrLine
forall a b. (a, b) -> b
snd [(Bool, AttrLine)]
lrest of
[] -> []
l1 :: AttrLine
l1 : rest :: [AttrLine]
rest -> (AttrLine
l1 AttrLine -> AttrLine -> AttrLine
forall a. [a] -> [a] -> [a]
++ AttrLine
lbonus) AttrLine -> [AttrLine] -> [AttrLine]
forall a. a -> [a] -> [a]
: [AttrLine]
rest
lFlat :: AttrLine
lFlat = AttrLine -> [AttrLine] -> AttrLine
forall a. [a] -> [[a]] -> [a]
intercalate [AttrCharW32
Color.spaceAttrW32]
([AttrLine] -> AttrLine) -> [AttrLine] -> AttrLine
forall a b. (a -> b) -> a -> b
$ ((Bool, AttrLine) -> AttrLine) -> [(Bool, AttrLine)] -> [AttrLine]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, AttrLine) -> AttrLine
forall a b. (a, b) -> b
snd [(Bool, AttrLine)]
ldischarged [AttrLine] -> [AttrLine] -> [AttrLine]
forall a. [a] -> [a] -> [a]
++ [AttrLine]
lWithBonus
lFits :: AttrLine
lFits = if AttrLine -> Int
forall a. [a] -> Int
length AttrLine
lFlat Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
width
then Int -> AttrLine -> AttrLine
forall a. Int -> [a] -> [a]
take (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- 3) AttrLine
lFlat AttrLine -> AttrLine -> AttrLine
forall a. [a] -> [a] -> [a]
++ [Char] -> AttrLine
stringToAL "..."
else AttrLine
lFlat
AttrLine -> m AttrLine
forall (m :: * -> *) a. Monad m => a -> m a
return (AttrLine -> m AttrLine) -> AttrLine -> m AttrLine
forall a b. (a -> b) -> a -> b
$! AttrLine
lFits
drawSelected :: MonadClientUI m
=> LevelId -> Int -> ES.EnumSet ActorId -> m (Int, AttrLine)
drawSelected :: LevelId -> Int -> EnumSet ActorId -> m (Int, AttrLine)
drawSelected drawnLevelId :: LevelId
drawnLevelId width :: Int
width selected :: EnumSet ActorId
selected = do
Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
ActorDictUI
sactorUI <- (SessionUI -> ActorDictUI) -> m ActorDictUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ActorDictUI
sactorUI
[(ActorId, Actor)]
ours <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((ActorId, Actor) -> Bool) -> (ActorId, Actor) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Actor -> Bool
bproj (Actor -> Bool)
-> ((ActorId, Actor) -> Actor) -> (ActorId, Actor) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> Actor
forall a b. (a, b) -> b
snd)
([(ActorId, Actor)] -> [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> State -> [(ActorId, Actor)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FactionId -> Bool) -> LevelId -> State -> [(ActorId, Actor)])
-> (FactionId -> Bool) -> LevelId -> State -> [(ActorId, Actor)]
forall a. a -> a
inline (FactionId -> Bool) -> LevelId -> State -> [(ActorId, Actor)]
actorAssocs (FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side) LevelId
drawnLevelId
let oursUI :: [(ActorId, Actor, ActorUI)]
oursUI = ((ActorId, Actor) -> (ActorId, Actor, ActorUI))
-> [(ActorId, Actor)] -> [(ActorId, Actor, ActorUI)]
forall a b. (a -> b) -> [a] -> [b]
map (\(aid :: ActorId
aid, b :: Actor
b) -> (ActorId
aid, Actor
b, ActorDictUI
sactorUI ActorDictUI -> ActorId -> ActorUI
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid)) [(ActorId, Actor)]
ours
viewOurs :: (ActorId, Actor, ActorUI) -> AttrCharW32
viewOurs (aid :: ActorId
aid, Actor{Int64
bhp :: Int64
bhp :: Actor -> Int64
bhp, Watchfulness
bwatch :: Watchfulness
bwatch :: Actor -> Watchfulness
bwatch}, ActorUI{Char
bsymbol :: Char
bsymbol :: ActorUI -> Char
bsymbol, Color
bcolor :: Color
bcolor :: ActorUI -> Color
bcolor}) =
let bg :: Highlight
bg = if | Maybe ActorId
mleader Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aid -> Highlight
Color.HighlightYellow
| Watchfulness
bwatch Watchfulness -> Watchfulness -> Bool
forall a. Eq a => a -> a -> Bool
== Watchfulness
WSleep -> Highlight
Color.HighlightGreen
| ActorId -> EnumSet ActorId -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
ES.member ActorId
aid EnumSet ActorId
selected -> Highlight
Color.HighlightBlue
| Bool
otherwise -> Highlight
Color.HighlightNone
sattr :: Attr
sattr = $WAttr :: Color -> Highlight -> Attr
Color.Attr {fg :: Color
Color.fg = Color
bcolor, Highlight
bg :: Highlight
bg :: Highlight
bg}
in AttrChar -> AttrCharW32
Color.attrCharToW32 (AttrChar -> AttrCharW32) -> AttrChar -> AttrCharW32
forall a b. (a -> b) -> a -> b
$ Attr -> Char -> AttrChar
Color.AttrChar Attr
sattr
(Char -> AttrChar) -> Char -> AttrChar
forall a b. (a -> b) -> a -> b
$ if Int64
bhp Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then Char
bsymbol else '%'
maxViewed :: Int
maxViewed = Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2
len :: Int
len = [(ActorId, Actor, ActorUI)] -> Int
forall a. [a] -> Int
length [(ActorId, Actor, ActorUI)]
oursUI
star :: AttrCharW32
star = let fg :: Color
fg = case EnumSet ActorId -> Int
forall k. EnumSet k -> Int
ES.size EnumSet ActorId
selected of
0 -> Color
Color.BrBlack
n :: Int
n | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len -> Color
Color.BrWhite
_ -> Color
Color.defFG
char :: Char
char = if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxViewed then '$' else '*'
in Color -> Char -> AttrCharW32
Color.attrChar2ToW32 Color
fg Char
char
viewed :: AttrLine
viewed = ((ActorId, Actor, ActorUI) -> AttrCharW32)
-> [(ActorId, Actor, ActorUI)] -> AttrLine
forall a b. (a -> b) -> [a] -> [b]
map (ActorId, Actor, ActorUI) -> AttrCharW32
viewOurs ([(ActorId, Actor, ActorUI)] -> AttrLine)
-> [(ActorId, Actor, ActorUI)] -> AttrLine
forall a b. (a -> b) -> a -> b
$ Int -> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall a. Int -> [a] -> [a]
take Int
maxViewed
([(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)])
-> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall a b. (a -> b) -> a -> b
$ ((ActorId, Actor, ActorUI)
-> (Bool, Bool, Bool, Char, Color, ActorId))
-> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (ActorId, Actor, ActorUI)
-> (Bool, Bool, Bool, Char, Color, ActorId)
keySelected [(ActorId, Actor, ActorUI)]
oursUI
(Int, AttrLine) -> m (Int, AttrLine)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
width (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2), [AttrCharW32
star] AttrLine -> AttrLine -> AttrLine
forall a. [a] -> [a] -> [a]
++ AttrLine
viewed AttrLine -> AttrLine -> AttrLine
forall a. [a] -> [a] -> [a]
++ [AttrCharW32
Color.spaceAttrW32])
checkWarningHP :: UIOptions -> ActorId -> Int64 -> State -> Bool
checkWarningHP :: UIOptions -> ActorId -> Int64 -> State -> Bool
checkWarningHP UIOptions{Int
uhpWarningPercent :: UIOptions -> Int
uhpWarningPercent :: Int
uhpWarningPercent} leader :: ActorId
leader hp :: Int64
hp s :: State
s =
let actorMaxSk :: Skills
actorMaxSk = ActorId -> State -> Skills
getActorMaxSkills ActorId
leader State
s
maxHp :: Int
maxHp = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMaxHP Skills
actorMaxSk
in Int64
hp Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Int64
xM (Int
uhpWarningPercent Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
maxHp Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 100)
checkWarningCalm :: UIOptions -> ActorId -> Int64 -> State -> Bool
checkWarningCalm :: UIOptions -> ActorId -> Int64 -> State -> Bool
checkWarningCalm UIOptions{Int
uhpWarningPercent :: Int
uhpWarningPercent :: UIOptions -> Int
uhpWarningPercent} leader :: ActorId
leader calm :: Int64
calm s :: State
s =
let b :: Actor
b = ActorId -> State -> Actor
getActorBody ActorId
leader State
s
actorMaxSk :: Skills
actorMaxSk = ActorId -> State -> Skills
getActorMaxSkills ActorId
leader State
s
isImpression :: ItemId -> Bool
isImpression iid :: ItemId
iid =
Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ GroupName ItemKind -> [(GroupName ItemKind, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "impressed" ([(GroupName ItemKind, Int)] -> Maybe Int)
-> [(GroupName ItemKind, Int)] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ItemKind -> [(GroupName ItemKind, Int)]
IK.ifreq (ItemKind -> [(GroupName ItemKind, Int)])
-> ItemKind -> [(GroupName ItemKind, Int)]
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemKind
getIidKind ItemId
iid State
s
isImpressed :: Bool
isImpressed = (ItemId -> Bool) -> [ItemId] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ItemId -> Bool
isImpression ([ItemId] -> Bool) -> [ItemId] -> Bool
forall a b. (a -> b) -> a -> b
$ ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys (ItemBag -> [ItemId]) -> ItemBag -> [ItemId]
forall a b. (a -> b) -> a -> b
$ Actor -> ItemBag
borgan Actor
b
maxCalm :: Int
maxCalm = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMaxCalm Skills
actorMaxSk
in Int64
calm Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Int64
xM (Int
uhpWarningPercent Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
maxCalm Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 100)
Bool -> Bool -> Bool
&& Bool
isImpressed
checkWarnings :: UIOptions -> ActorId -> State -> (Bool, Bool)
checkWarnings :: UIOptions -> ActorId -> State -> (Bool, Bool)
checkWarnings uiOptions :: UIOptions
uiOptions leader :: ActorId
leader s :: State
s =
let b :: Actor
b = ActorId -> State -> Actor
getActorBody ActorId
leader State
s
in ( UIOptions -> ActorId -> Int64 -> State -> Bool
checkWarningHP UIOptions
uiOptions ActorId
leader (Actor -> Int64
bhp Actor
b) State
s
, UIOptions -> ActorId -> Int64 -> State -> Bool
checkWarningCalm UIOptions
uiOptions ActorId
leader (Actor -> Int64
bcalm Actor
b) State
s )