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