git.iko.soy/vty
on ffe6de2 help sign in
vty/src/Graphics/Vty/Attributes.hs
232 lines 7.8 kB history raw
1{-# LANGUAGE StandaloneDeriving #-}
2{-# LANGUAGE GADTs #-}
3{-# LANGUAGE RankNTypes #-}
4-- | Display attributes
5--
6-- For efficiency, this could be encoded into a single 32 bit word. The 32 bit word is first divided
7-- into 4 groups of 8 bits where: The first group codes what action should be taken with regards to
8-- the other groups.
9-- XXYYZZ__
10-- XX - style action
11-- 00 => reset to default
12-- 01 => unchanged
13-- 10 => set
14-- YY - foreground color action
15-- 00 => reset to default
16-- 01 => unchanged
17-- 10 => set
18-- ZZ - background color action
19-- 00 => reset to default
20-- 01 => unchanged
21-- 10 => set
22-- __ - unused
23--
24-- Next is the style flags
25-- SURBDO__
26-- S - standout
27-- U - underline
28-- R - reverse video
29-- B - blink
30-- D - dim
31-- O - bold
32-- __ - unused
33--
34-- Then the foreground color encoded into 8 bits.
35-- Then the background color encoded into 8 bits.
36--
37module Graphics.Vty.Attributes
38 where
40import Data.Bits
41import Data.Monoid
42import Data.Word
44-- | A display attribute defines the Color and Style of all the characters rendered after the
45-- attribute is applied.
46--
47-- At most 256 colors, picked from a 240 and 16 color palette, are possible for the background and
48-- foreground. The 240 colors and 16 colors are points in different palettes. See Color for more
49-- information.
50data Attr = Attr
51 { attr_style :: !(MaybeDefault Style)
52 , attr_fore_color :: !(MaybeDefault Color)
53 , attr_back_color :: !(MaybeDefault Color)
54 } deriving ( Eq, Show )
56instance Monoid Attr where
57 mempty = Attr mempty mempty mempty
58 mappend attr_0 attr_1 =
59 Attr ( attr_style attr_0 `mappend` attr_style attr_1 )
60 ( attr_fore_color attr_0 `mappend` attr_fore_color attr_1 )
61 ( attr_back_color attr_0 `mappend` attr_back_color attr_1 )
63-- | Specifies the display attributes such that the final style and color values do not depend on
64-- the previously applied display attribute. The display attributes can still depend on the
65-- terminal's default colors (unfortunately).
66data FixedAttr = FixedAttr
67 { fixed_style :: !Style
68 , fixed_fore_color :: !(Maybe Color)
69 , fixed_back_color :: !(Maybe Color)
70 } deriving ( Eq, Show )
72-- | The style and color attributes can either be the terminal defaults. Or be equivalent to the
73-- previously applied style. Or be a specific value.
74data MaybeDefault v where
75 Default :: MaybeDefault v
76 KeepCurrent :: MaybeDefault v
77 SetTo :: forall v . ( Eq v, Show v ) => !v -> MaybeDefault v
79deriving instance Eq v => Eq (MaybeDefault v)
80deriving instance Eq v => Show (MaybeDefault v)
82instance Eq v => Monoid ( MaybeDefault v ) where
83 mempty = KeepCurrent
84 mappend Default Default = Default
85 mappend Default KeepCurrent = Default
86 mappend Default ( SetTo v ) = SetTo v
87 mappend KeepCurrent Default = Default
88 mappend KeepCurrent KeepCurrent = KeepCurrent
89 mappend KeepCurrent ( SetTo v ) = SetTo v
90 mappend ( SetTo _v ) Default = Default
91 mappend ( SetTo v ) KeepCurrent = SetTo v
92 mappend ( SetTo _ ) ( SetTo v ) = SetTo v
94-- | Abstract data type representing a color.
95--
96-- Currently the foreground and background color are specified as points in either a:
97--
98-- * 16 color palette. Where the first 8 colors are equal to the 8 colors of the ISO 6429 (ANSI) 8
99-- color palette and the second 8 colors are bright/vivid versions of the first 8 colors.
100--
101-- * 240 color palette. This palette is a regular sampling of the full RGB colorspace.
102--
103-- The 8 ISO 6429 (ANSI) colors are as follows:
104--
105-- 0. black
106--
107-- 1. red
108--
109-- 2. green
110--
111-- 3. yellow
112--
113-- 4. blue
114--
115-- 5. magenta
116--
117-- 6. cyan
118--
119-- 7. white
120--
121-- The mapping from points in the 240 color palette to colors actually displayable by the terminal
122-- depends on the number of colors the terminal claims to support. Which is usually determined by
123-- the terminfo "colors" property. If this property is not being accurately reported then the color
124-- reproduction will be incorrect.
125--
126-- If the terminal reports <= 16 colors then the 240 color palette points are only mapped to the 8
127-- color pallete. I'm not sure of the RGB points for the "bright" colors which is why they are not
128-- addressable via the 240 color palette.
129--
130-- If the terminal reports > 16 colors then the 240 color palette points are mapped to the nearest
131-- points in a ("color count" - 16) subsampling of the 240 color palette.
132--
133-- All of this assumes the terminals are behaving similarly to xterm and rxvt when handling colors.
134-- And that the individual colors have not been remapped by the user. There may be a way to verify
135-- this through terminfo but I don't know it.
136--
137-- Seriously, terminal color support is INSANE.
138data Color = ISOColor !Word8 | Color240 !Word8
139 deriving ( Eq, Show )
141-- | Standard 8-color ANSI terminal color codes.
142black, red, green, yellow, blue, magenta, cyan, white :: Color
143black = ISOColor 0
144red = ISOColor 1
145green = ISOColor 2
146yellow = ISOColor 3
147blue = ISOColor 4
148magenta= ISOColor 5
149cyan = ISOColor 6
150white = ISOColor 7
152-- | Bright/Vivid variants of the standard 8-color ANSI
153bright_black, bright_red, bright_green, bright_yellow :: Color
154bright_blue, bright_magenta, bright_cyan, bright_white :: Color
155bright_black = ISOColor 8
156bright_red = ISOColor 9
157bright_green = ISOColor 10
158bright_yellow = ISOColor 11
159bright_blue = ISOColor 12
160bright_magenta= ISOColor 13
161bright_cyan = ISOColor 14
162bright_white = ISOColor 15
164-- | Styles are represented as an 8 bit word. Each bit in the word is 1 if the style attribute
165-- assigned to that bit should be applied and 0 if the style attribute should not be applied.
166type Style = Word8
168-- | The 6 possible style attributes:
169--
170-- * standout
171--
172-- * underline
173--
174-- * reverse_video
175--
176-- * blink
177--
178-- * dim
179--
180-- * bold/bright
181--
182-- ( The invisible, protect, and altcharset display attributes some terminals support are not
183-- supported via VTY.)
184standout, underline, reverse_video, blink, dim, bold :: Style
185standout = 0x01
186underline = 0x02
187reverse_video = 0x04
188blink = 0x08
189dim = 0x10
190bold = 0x20
192default_style_mask :: Style
193default_style_mask = 0x00
195style_mask :: Attr -> Word8
196style_mask attr
197 = case attr_style attr of
198 Default -> 0
199 KeepCurrent -> 0
200 SetTo v -> v
202-- | true if the given Style value has the specified Style set.
203has_style :: Style -> Style -> Bool
204has_style s bit_mask = ( s .&. bit_mask ) /= 0
206-- | Set the foreground color of an `Attr'.
207with_fore_color :: Attr -> Color -> Attr
208with_fore_color attr c = attr { attr_fore_color = SetTo c }
210-- | Set the background color of an `Attr'.
211with_back_color :: Attr -> Color -> Attr
212with_back_color attr c = attr { attr_back_color = SetTo c }
214-- | Add the given style attribute
215with_style :: Attr -> Style -> Attr
216with_style attr style_flag = attr { attr_style = SetTo $ style_mask attr .|. style_flag }
218-- | Sets the style, background color and foreground color to the default values for the terminal.
219-- There is no easy way to determine what the default background and foreground colors are.
220def_attr :: Attr
221def_attr = Attr Default Default Default
223-- | Keeps the style, background color and foreground color that was previously set. Used to
224-- override some part of the previous style.
225--
226-- EG: current_style `with_fore_color` bright_magenta
227--
228-- Would be the currently applied style (be it underline, bold, etc) but with the foreground color
229-- set to bright_magenta.
230current_attr :: Attr
231current_attr = Attr KeepCurrent KeepCurrent KeepCurrent