LambdaHack-0.11.0.0: A game engine library for tactical squad ASCII roguelike dungeon crawlers
Safe HaskellNone
LanguageHaskell2010

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

Msg

data Msg Source #

The type of a single game message.

Instances

Instances details
Eq Msg Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Methods

(==) :: Msg -> Msg -> Bool #

(/=) :: Msg -> Msg -> Bool #

Ord Msg Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Methods

compare :: Msg -> Msg -> Ordering #

(<) :: Msg -> Msg -> Bool #

(<=) :: Msg -> Msg -> Bool #

(>) :: Msg -> Msg -> Bool #

(>=) :: Msg -> Msg -> Bool #

max :: Msg -> Msg -> Msg #

min :: Msg -> Msg -> Msg #

Show Msg Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Methods

showsPrec :: Int -> Msg -> ShowS #

show :: Msg -> String #

showList :: [Msg] -> ShowS #

Generic Msg Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Associated Types

type Rep Msg :: Type -> Type #

Methods

from :: Msg -> Rep Msg x #

to :: Rep Msg x -> Msg #

Binary Msg Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Methods

put :: Msg -> Put #

get :: Get Msg #

putList :: [Msg] -> Put #

type Rep Msg Source # 
Instance details

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))))

class MsgShared a Source #

Minimal complete definition

toMsgShared

toMsgShared :: MsgShared a => [(String, Color)] -> a -> Text -> Msg Source #

data MsgClassShowAndSave Source #

Instances

Instances details
Bounded MsgClassShowAndSave Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Enum MsgClassShowAndSave Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Eq MsgClassShowAndSave Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Ord MsgClassShowAndSave Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Show MsgClassShowAndSave Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Generic MsgClassShowAndSave Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Associated Types

type Rep MsgClassShowAndSave :: Type -> Type #

Binary MsgClassShowAndSave Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

MsgShared MsgClassShowAndSave Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

type Rep MsgClassShowAndSave Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

type Rep MsgClassShowAndSave = D1 ('MetaData "MsgClassShowAndSave" "Game.LambdaHack.Client.UI.Msg" "LambdaHack-0.11.0.0-inplace" 'False) (((((C1 ('MetaCons "MsgBookKeeping" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MsgStatusWakeup" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "MsgStatusStopUs" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "MsgStatusStopThem" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MsgItemCreation" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: ((C1 ('MetaCons "MsgItemRuination" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "MsgDeathVictory" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MsgDeathDeafeat" 'PrefixI 'False) (U1 :: Type -> Type))) :+: (C1 ('MetaCons "MsgDeathBoring" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "MsgRiskOfDeath" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MsgPointmanSwap" 'PrefixI 'False) (U1 :: Type -> Type))))) :+: (((C1 ('MetaCons "MsgFactionIntel" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "MsgFinalOutcome" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MsgBackdropInfo" 'PrefixI 'False) (U1 :: Type -> Type))) :+: (C1 ('MetaCons "MsgTerrainReveal" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "MsgItemDiscovery" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MsgSpottedActor" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: ((C1 ('MetaCons "MsgItemMovement" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "MsgActionMajor" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MsgActionMinor" 'PrefixI 'False) (U1 :: Type -> Type))) :+: (C1 ('MetaCons "MsgEffectMajor" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "MsgEffectMedium" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MsgEffectMinor" 'PrefixI 'False) (U1 :: Type -> Type)))))) :+: ((((C1 ('MetaCons "MsgMiscellanous" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "MsgHeardOutside" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MsgHeardNearby" 'PrefixI 'False) (U1 :: Type -> Type))) :+: (C1 ('MetaCons "MsgHeardFaraway" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "MsgBackdropFocus" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MsgActionWarning" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: ((C1 ('MetaCons "MsgRangedMightyWe" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "MsgRangedMightyUs" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MsgRangedOthers" 'PrefixI 'False) (U1 :: Type -> Type))) :+: (C1 ('MetaCons "MsgRangedNormalUs" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "MsgGoodMiscEvent" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MsgBadMiscEvent" 'PrefixI 'False) (U1 :: Type -> Type))))) :+: (((C1 ('MetaCons "MsgNeutralEvent" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "MsgSpecialEvent" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MsgMeleeMightyWe" 'PrefixI 'False) (U1 :: Type -> Type))) :+: (C1 ('MetaCons "MsgMeleeMightyUs" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "MsgMeleeComplexWe" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MsgMeleeComplexUs" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: ((C1 ('MetaCons "MsgMeleeOthers" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "MsgMeleeNormalUs" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MsgActionComplete" 'PrefixI 'False) (U1 :: Type -> Type))) :+: (C1 ('MetaCons "MsgAtFeetMajor" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "MsgAtFeetMinor" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MsgTutorialHint" 'PrefixI 'False) (U1 :: Type -> Type)))))))

data MsgClassShow Source #

Instances

Instances details
Bounded MsgClassShow Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Enum MsgClassShow Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Eq MsgClassShow Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Ord MsgClassShow Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Show MsgClassShow Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Generic MsgClassShow Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Associated Types

type Rep MsgClassShow :: Type -> Type #

Binary MsgClassShow Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

MsgShared MsgClassShow Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

type Rep MsgClassShow Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

type Rep MsgClassShow = D1 ('MetaData "MsgClassShow" "Game.LambdaHack.Client.UI.Msg" "LambdaHack-0.11.0.0-inplace" 'False) (((C1 ('MetaCons "MsgPromptGeneric" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MsgPromptFocus" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "MsgPromptMention" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MsgPromptModify" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "MsgPromptActors" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MsgPromptItems" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "MsgPromptAction" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "MsgActionAlert" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MsgSpottedThreat" 'PrefixI 'False) (U1 :: Type -> Type)))))

data MsgClassSave Source #

Instances

Instances details
Bounded MsgClassSave Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Enum MsgClassSave Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Eq MsgClassSave Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Ord MsgClassSave Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Show MsgClassSave Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Generic MsgClassSave Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Associated Types

type Rep MsgClassSave :: Type -> Type #

Binary MsgClassSave Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

MsgShared MsgClassSave Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

type Rep MsgClassSave Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

type Rep MsgClassSave = D1 ('MetaData "MsgClassSave" "Game.LambdaHack.Client.UI.Msg" "LambdaHack-0.11.0.0-inplace" 'False) (C1 ('MetaCons "MsgInnerWorkSpam" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MsgNumericReport" 'PrefixI 'False) (U1 :: Type -> Type))

data MsgClassIgnore Source #

Instances

Instances details
Bounded MsgClassIgnore Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Enum MsgClassIgnore Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Eq MsgClassIgnore Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Ord MsgClassIgnore Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Show MsgClassIgnore Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Generic MsgClassIgnore Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Associated Types

type Rep MsgClassIgnore :: Type -> Type #

Binary MsgClassIgnore Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

MsgShared MsgClassIgnore Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

type Rep MsgClassIgnore Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

type Rep MsgClassIgnore = D1 ('MetaData "MsgClassIgnore" "Game.LambdaHack.Client.UI.Msg" "LambdaHack-0.11.0.0-inplace" 'False) (C1 ('MetaCons "MsgMacroOperation" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "MsgRunStopReason" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MsgStopPlayback" 'PrefixI 'False) (U1 :: Type -> Type)))

data MsgClassDistinct Source #

Instances

Instances details
Bounded MsgClassDistinct Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Enum MsgClassDistinct Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Eq MsgClassDistinct Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Ord MsgClassDistinct Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Show MsgClassDistinct Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Generic MsgClassDistinct Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Associated Types

type Rep MsgClassDistinct :: Type -> Type #

Binary MsgClassDistinct Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

type Rep MsgClassDistinct Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

type Rep MsgClassDistinct = D1 ('MetaData "MsgClassDistinct" "Game.LambdaHack.Client.UI.Msg" "LambdaHack-0.11.0.0-inplace" 'False) (((C1 ('MetaCons "MsgSpottedItem" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MsgStatusSleep" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "MsgStatusGoodUs" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MsgStatusBadUs" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "MsgStatusOthers" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MsgStatusBenign" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "MsgStatusWarning" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "MsgStatusLongerUs" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MsgStatusLongThem" 'PrefixI 'False) (U1 :: Type -> Type)))))

data MsgClass Source #

Instances

Instances details
Eq MsgClass Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Ord MsgClass Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Show MsgClass Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Generic MsgClass Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Associated Types

type Rep MsgClass :: Type -> Type #

Methods

from :: MsgClass -> Rep MsgClass x #

to :: Rep MsgClass x -> MsgClass #

Binary MsgClass Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Methods

put :: MsgClass -> Put #

get :: Get MsgClass #

putList :: [MsgClass] -> Put #

type Rep MsgClass Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Report

data Report Source #

The set of messages, with repetitions, to show at the screen at once.

Instances

Instances details
Show Report Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Binary Report Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Methods

put :: Report -> Put #

get :: Get Report #

putList :: [Report] -> Put #

nullVisibleReport :: Report -> Bool Source #

Test if the list of non-whitespace messages is empty.

consReport :: Msg -> Report -> Report Source #

Add a message to the start of report.

renderReport :: Bool -> Report -> [AttrString] Source #

Render a report as a (possibly very long) list of AttrString.

History

data History Source #

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

Instances details
Show History Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Generic History Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Associated Types

type Rep History :: Type -> Type #

Methods

from :: History -> Rep History x #

to :: Rep History x -> History #

Binary History Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Methods

put :: History -> Put #

get :: Get History #

putList :: [History] -> Put #

type Rep History Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

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.

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

data RepMsgNK Source #

Instances

Instances details
Show RepMsgNK Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Generic RepMsgNK Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Associated Types

type Rep RepMsgNK :: Type -> Type #

Methods

from :: RepMsgNK -> Rep RepMsgNK x #

to :: Rep RepMsgNK x -> RepMsgNK #

Binary RepMsgNK Source # 
Instance details

Defined in Game.LambdaHack.Client.UI.Msg

Methods

put :: RepMsgNK -> Put #

get :: Get RepMsgNK #

putList :: [RepMsgNK] -> Put #

type Rep RepMsgNK Source # 
Instance details

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.