git.iko.soy/vty
on d64ff96 help sign in
vty/src/Graphics/Vty/Attributes.hs
269 lines 8.2 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE StandaloneDeriving #-}
3{-# LANGUAGE GADTs #-}
4{-# LANGUAGE RankNTypes #-}
5{-# LANGUAGE DeriveGeneric #-}
6{-# LANGUAGE DeriveAnyClass #-}
8-- | Display attributes
9--
10-- Attributes have three components: a foreground color, a background
11-- color, and a style mask. The simplest attribute is the default
12-- attribute, or 'defAttr'. Attributes can be modified with
13-- 'withForeColor', 'withBackColor', and 'withStyle', e.g.,
14--
15-- @
16-- defAttr \`withForeColor\` red
17-- @
18--
19-- 'Image' constructors often require an 'Attr' to indicate the
20-- attributes used in the image, e.g.,
21--
22-- @
23-- string (defAttr \`withForeColor\` red) "this text will be red"
24-- @
25--
26-- The appearance of 'Image's using 'defAttr' is determined by the The
27-- terminal, so this is not something VTY can control. The user is free
28-- to The define the color scheme of the terminal as they see fit.
29--
30-- The value 'currentAttr' will keep the attributes of whatever was
31-- output previously.
32module Graphics.Vty.Attributes
33 ( Attr(..)
34 , FixedAttr(..)
35 , MaybeDefault(..)
36 , defAttr
37 , currentAttr
39 -- * Styles
40 , Style
41 , withStyle
42 , standout
43 , italic
44 , underline
45 , reverseVideo
46 , blink
47 , dim
48 , bold
49 , defaultStyleMask
50 , styleMask
51 , hasStyle
53 -- * Setting attribute colors
54 , withForeColor
55 , withBackColor
57 -- * Setting hyperlinks
58 , withURL
60 -- * Colors
61 , module Graphics.Vty.Attributes.Color
62 , module Graphics.Vty.Attributes.Color240
63 )
64where
66import Control.DeepSeq
67import Data.Bits
68#if !(MIN_VERSION_base(4,11,0))
69import Data.Semigroup
70#endif
71import Data.Text (Text)
72import Data.Word
73import GHC.Generics
75import Graphics.Vty.Attributes.Color
76import Graphics.Vty.Attributes.Color240
78-- | A display attribute defines the Color and Style of all the
79-- characters rendered after the attribute is applied.
80--
81-- At most 256 colors, picked from a 240 and 16 color palette, are
82-- possible for the background and foreground. The 240 colors and
83-- 16 colors are points in different palettes. See Color for more
84-- information.
85data Attr = Attr
86 { attrStyle :: !(MaybeDefault Style)
87 , attrForeColor :: !(MaybeDefault Color)
88 , attrBackColor :: !(MaybeDefault Color)
89 , attrURL :: !(MaybeDefault Text)
90 } deriving ( Eq, Show, Read, Generic, NFData )
92-- This could be encoded into a single 32 bit word. The 32 bit word is
93-- first divided into 4 groups of 8 bits where: The first group codes
94-- what action should be taken with regards to the other groups.
95-- XXYYZZ__
96-- XX - style action
97-- 00 => reset to default
98-- 01 => unchanged
99-- 10 => set
100-- YY - foreground color action
101-- 00 => reset to default
102-- 01 => unchanged
103-- 10 => set
104-- ZZ - background color action
105-- 00 => reset to default
106-- 01 => unchanged
107-- 10 => set
108-- __ - unused
109--
110-- Next is the style flags
111-- SURBDOI_
112-- S - standout
113-- U - underline
114-- R - reverse video
115-- B - blink
116-- D - dim
117-- O - bold
118-- I - italic
119-- _ - unused
120--
121-- Then the foreground color encoded into 8 bits.
122-- Then the background color encoded into 8 bits.
124instance Semigroup Attr where
125 attr0 <> attr1 =
126 Attr ( attrStyle attr0 <> attrStyle attr1 )
127 ( attrForeColor attr0 <> attrForeColor attr1 )
128 ( attrBackColor attr0 <> attrBackColor attr1 )
129 ( attrURL attr0 <> attrURL attr1 )
131instance Monoid Attr where
132 mempty = Attr mempty mempty mempty mempty
133#if !(MIN_VERSION_base(4,11,0))
134 mappend = (<>)
135#endif
137-- | Specifies the display attributes such that the final style and
138-- color values do not depend on the previously applied display
139-- attribute. The display attributes can still depend on the terminal's
140-- default colors (unfortunately).
141data FixedAttr = FixedAttr
142 { fixedStyle :: !Style
143 , fixedForeColor :: !(Maybe Color)
144 , fixedBackColor :: !(Maybe Color)
145 , fixedURL :: !(Maybe Text)
146 } deriving ( Eq, Show )
148-- | The style and color attributes can either be the terminal defaults.
149-- Or be equivalent to the previously applied style. Or be a specific
150-- value.
151data MaybeDefault v where
152 Default :: MaybeDefault v
153 KeepCurrent :: MaybeDefault v
154 SetTo :: forall v . ( Eq v, Show v, Read v ) => !v -> MaybeDefault v
156instance (NFData v) => NFData (MaybeDefault v) where
157 rnf Default = ()
158 rnf KeepCurrent = ()
159 rnf (SetTo v) = rnf v
161deriving instance Eq v => Eq (MaybeDefault v)
162deriving instance Eq v => Show (MaybeDefault v)
163deriving instance (Eq v, Show v, Read v) => Read (MaybeDefault v)
165instance Eq v => Semigroup (MaybeDefault v) where
166 Default <> Default = Default
167 Default <> KeepCurrent = Default
168 Default <> SetTo v = SetTo v
169 KeepCurrent <> Default = Default
170 KeepCurrent <> KeepCurrent = KeepCurrent
171 KeepCurrent <> SetTo v = SetTo v
172 SetTo _v <> Default = Default
173 SetTo v <> KeepCurrent = SetTo v
174 SetTo _ <> SetTo v = SetTo v
176instance Eq v => Monoid ( MaybeDefault v ) where
177 mempty = KeepCurrent
178#if !(MIN_VERSION_base(4,11,0))
179 mappend = (<>)
180#endif
182-- | Styles are represented as an 8 bit word. Each bit in the word is 1
183-- if the style attribute assigned to that bit should be applied and 0
184-- if the style attribute should not be applied.
185type Style = Word8
187-- | The 7 possible style attributes:
188--
189-- * standout
190--
191-- * underline
192--
193-- * reverseVideo
194--
195-- * blink
196--
197-- * dim
198--
199-- * bold/bright
200--
201-- * italic
202--
203-- (The invisible, protect, and altcharset display attributes some
204-- terminals support are not supported via VTY.)
205standout, underline, reverseVideo, blink, dim, bold, italic :: Style
206standout = 0x01
207underline = 0x02
208reverseVideo = 0x04
209blink = 0x08
210dim = 0x10
211bold = 0x20
212italic = 0x40
214defaultStyleMask :: Style
215defaultStyleMask = 0x00
217styleMask :: Attr -> Word8
218styleMask attr
219 = case attrStyle attr of
220 Default -> 0
221 KeepCurrent -> 0
222 SetTo v -> v
224-- | true if the given Style value has the specified Style set.
225hasStyle :: Style -> Style -> Bool
226hasStyle s bitMask = ( s .&. bitMask ) /= 0
228-- | Set the foreground color of an `Attr'.
229withForeColor :: Attr -> Color -> Attr
230withForeColor attr c = attr { attrForeColor = SetTo c }
232-- | Set the background color of an `Attr'.
233withBackColor :: Attr -> Color -> Attr
234withBackColor attr c = attr { attrBackColor = SetTo c }
236-- | Add the given style attribute
237withStyle :: Attr -> Style -> Attr
238withStyle attr 0 = attr
239withStyle attr styleFlag = attr { attrStyle = SetTo $ styleMask attr .|. styleFlag }
241-- | Add a hyperlinked URL using the proposed [escape sequences for
242-- hyperlinked
243-- URLs](https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda).
244-- These escape sequences are comparatively new and aren't widely
245-- supported in terminal emulators yet, but most terminal emulators
246-- that don't know about these sequences will ignore these sequences,
247-- and therefore this should fall back sensibly. In some cases they
248-- won't and this will result in garbage, so this is why hyperlinking is
249-- disabled by default, in which case this combinator has no observable
250-- effect. To enable it, enable 'Hyperlink' mode on your Vty output
251-- interface.
252withURL :: Attr -> Text -> Attr
253withURL attr url = attr { attrURL = SetTo url }
255-- | Sets the style, background color and foreground color to the
256-- default values for the terminal. There is no easy way to determine
257-- what the default background and foreground colors are.
258defAttr :: Attr
259defAttr = Attr Default Default Default Default
261-- | Keeps the style, background color and foreground color that was
262-- previously set. Used to override some part of the previous style.
263--
264-- EG: current_style `withForeColor` brightMagenta
265--
266-- Would be the currently applied style (be it underline, bold, etc) but
267-- with the foreground color set to brightMagenta.
268currentAttr :: Attr
269currentAttr = Attr KeepCurrent KeepCurrent KeepCurrent KeepCurrent