Safe Haskell | None |
---|---|
Language | Haskell2010 |
Game.LambdaHack.Client.UI.Msg
Description
Game messages displayed on top of the screen for the player to read and then saved to player history.
Synopsis
- data Msg
- class MsgShared a
- toMsgShared :: MsgShared a => [(String, Color)] -> a -> Text -> Msg
- toMsgDistinct :: [(String, Color)] -> MsgClassDistinct -> Text -> Text -> Msg
- data MsgClassShowAndSave
- = MsgBookKeeping
- | MsgStatusWakeup
- | MsgStatusStopUs
- | MsgStatusStopThem
- | MsgItemCreation
- | MsgItemRuination
- | MsgDeathVictory
- | MsgDeathDeafeat
- | MsgDeathBoring
- | MsgRiskOfDeath
- | MsgPointmanSwap
- | MsgFactionIntel
- | MsgFinalOutcome
- | MsgBackdropInfo
- | MsgTerrainReveal
- | MsgItemDiscovery
- | MsgSpottedActor
- | MsgItemMovement
- | MsgActionMajor
- | MsgActionMinor
- | MsgEffectMajor
- | MsgEffectMedium
- | MsgEffectMinor
- | MsgMiscellanous
- | MsgHeardOutside
- | MsgHeardNearby
- | MsgHeardFaraway
- | MsgBackdropFocus
- | MsgActionWarning
- | MsgRangedMightyWe
- | MsgRangedMightyUs
- | MsgRangedOthers
- | MsgRangedNormalUs
- | MsgGoodMiscEvent
- | MsgBadMiscEvent
- | MsgNeutralEvent
- | MsgSpecialEvent
- | MsgMeleeMightyWe
- | MsgMeleeMightyUs
- | MsgMeleeComplexWe
- | MsgMeleeComplexUs
- | MsgMeleeOthers
- | MsgMeleeNormalUs
- | MsgActionComplete
- | MsgAtFeetMajor
- | MsgAtFeetMinor
- | MsgTutorialHint
- data MsgClassShow
- data MsgClassSave
- data MsgClassIgnore
- data MsgClassDistinct
- data MsgClass
- interruptsRunning :: MsgClass -> Bool
- disturbsResting :: MsgClass -> Bool
- data Report
- nullVisibleReport :: Report -> Bool
- consReport :: Msg -> Report -> Report
- renderReport :: Bool -> Report -> [AttrString]
- anyInReport :: (MsgClass -> Bool) -> Report -> Bool
- data History
- newReport :: History -> Report
- emptyHistory :: Int -> History
- addToReport :: Set Msg -> Bool -> Bool -> History -> Msg -> Time -> (Set Msg, History, Bool)
- addEolToNewReport :: History -> History
- archiveReport :: History -> History
- lengthHistory :: History -> Int
- renderHistory :: History -> [AttrString]
- type UAttrString = Vector Word32
- uToAttrString :: UAttrString -> AttrString
- attrStringToU :: AttrString -> UAttrString
- toMsg :: [(String, Color)] -> MsgPrototype -> Msg
- data MsgPrototype
- tripleFromProto :: MsgPrototype -> (Text, Text, MsgClass)
- scrapsRepeats :: MsgClass -> Bool
- isTutorialHint :: MsgClass -> Bool
- msgColor :: MsgClass -> Color
- data RepMsgNK
- nullRepMsgNK :: RepMsgNK -> Bool
- emptyReport :: Report
- renderRepetition :: (AttrString, Int) -> AttrString
- scrapRepetitionSingle :: (AttrString, Int) -> [(AttrString, Int)] -> [(AttrString, Int)] -> (Bool, [(AttrString, Int)], [(AttrString, Int)])
- scrapRepetition :: History -> Maybe History
- renderTimeReport :: Time -> Report -> [AttrString]
Msg
The type of a single game message.
Instances
Eq Msg Source # | |
Ord Msg Source # | |
Show Msg Source # | |
Generic Msg Source # | |
Binary Msg Source # | |
type Rep Msg Source # | |
Defined in Game.LambdaHack.Client.UI.Msg type Rep Msg = D1 ('MetaData "Msg" "Game.LambdaHack.Client.UI.Msg" "LambdaHack-0.11.0.0-inplace" 'False) (C1 ('MetaCons "Msg" 'PrefixI 'True) (S1 ('MetaSel ('Just "msgShow") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 AttrString) :*: (S1 ('MetaSel ('Just "msgSave") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 AttrString) :*: S1 ('MetaSel ('Just "msgClass") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 MsgClass)))) |
toMsgDistinct :: [(String, Color)] -> MsgClassDistinct -> Text -> Text -> Msg Source #
data MsgClassShowAndSave Source #
Constructors
Instances
data MsgClassShow Source #
Constructors
MsgPromptGeneric | |
MsgPromptFocus | |
MsgPromptMention | |
MsgPromptModify | |
MsgPromptActors | |
MsgPromptItems | |
MsgPromptAction | |
MsgActionAlert | |
MsgSpottedThreat |
Instances
data MsgClassSave Source #
Constructors
MsgInnerWorkSpam | |
MsgNumericReport |
Instances
data MsgClassIgnore Source #
Constructors
MsgMacroOperation | |
MsgRunStopReason | |
MsgStopPlayback |
Instances
data MsgClassDistinct Source #
Constructors
MsgSpottedItem | |
MsgStatusSleep | |
MsgStatusGoodUs | |
MsgStatusBadUs | |
MsgStatusOthers | |
MsgStatusBenign | |
MsgStatusWarning | |
MsgStatusLongerUs | |
MsgStatusLongThem |
Instances
Instances
interruptsRunning :: MsgClass -> Bool Source #
disturbsResting :: MsgClass -> Bool Source #
Report
The set of messages, with repetitions, to show at the screen at once.
nullVisibleReport :: Report -> Bool Source #
Test if the list of non-whitespace messages is empty.
renderReport :: Bool -> Report -> [AttrString] Source #
Render a report as a (possibly very long) list of AttrString
.
History
The history of reports. This is a ring buffer of the given length containing old archived history and two most recent reports stored separately.
Instances
Show History Source # | |
Generic History Source # | |
Binary History Source # | |
type Rep History Source # | |
Defined in Game.LambdaHack.Client.UI.Msg type Rep History = D1 ('MetaData "History" "Game.LambdaHack.Client.UI.Msg" "LambdaHack-0.11.0.0-inplace" 'False) (C1 ('MetaCons "History" 'PrefixI 'True) ((S1 ('MetaSel ('Just "newReport") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Report) :*: S1 ('MetaSel ('Just "newTime") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Time)) :*: (S1 ('MetaSel ('Just "oldReport") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Report) :*: (S1 ('MetaSel ('Just "oldTime") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Time) :*: S1 ('MetaSel ('Just "archivedHistory") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (RingBuffer UAttrString)))))) |
emptyHistory :: Int -> History Source #
Empty history of the given maximal length.
addToReport :: Set Msg -> Bool -> Bool -> History -> Msg -> Time -> (Set Msg, History, Bool) Source #
Add a message to the new report of history, eliminating a possible duplicate and noting its existence in the result.
addEolToNewReport :: History -> History Source #
Add a newline to end of the new report of history, unless empty.
archiveReport :: History -> History Source #
Archive old report to history, filtering out messages with 0 duplicates and prompts. Set up new report with a new timestamp.
lengthHistory :: History -> Int Source #
renderHistory :: History -> [AttrString] Source #
Render history as many lines of text. New report is not rendered. It's expected to be empty when history is shown.
Internal operations
type UAttrString = Vector Word32 Source #
data MsgPrototype Source #
tripleFromProto :: MsgPrototype -> (Text, Text, MsgClass) Source #
scrapsRepeats :: MsgClass -> Bool Source #
isTutorialHint :: MsgClass -> Bool Source #
Instances
Show RepMsgNK Source # | |
Generic RepMsgNK Source # | |
Binary RepMsgNK Source # | |
type Rep RepMsgNK Source # | |
Defined in Game.LambdaHack.Client.UI.Msg type Rep RepMsgNK = D1 ('MetaData "RepMsgNK" "Game.LambdaHack.Client.UI.Msg" "LambdaHack-0.11.0.0-inplace" 'False) (C1 ('MetaCons "RepMsgNK" 'PrefixI 'True) (S1 ('MetaSel ('Just "repMsg") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Msg) :*: (S1 ('MetaSel ('Just "_repShow") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Int) :*: S1 ('MetaSel ('Just "_repSave") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Int)))) |
nullRepMsgNK :: RepMsgNK -> Bool Source #
If only one of the message components is non-empty and non-whitespace, but its count is zero, the message is considered empty.
emptyReport :: Report Source #
Empty set of messages.
renderRepetition :: (AttrString, Int) -> AttrString Source #
scrapRepetitionSingle :: (AttrString, Int) -> [(AttrString, Int)] -> [(AttrString, Int)] -> (Bool, [(AttrString, Int)], [(AttrString, Int)]) Source #
renderTimeReport :: Time -> Report -> [AttrString] Source #