git.iko.soy/vty
on 8e0c7cc help sign in
vty/src/Graphics/Vty/Attributes.hs
217 lines 7.1 kB history raw
1{-# LANGUAGE StandaloneDeriving #-}
2{-# LANGUAGE GADTs #-}
3{-# LANGUAGE RankNTypes #-}
4-- | Display attributes
5--
6-- Typically the values 'defAttr' or 'currentAttr' are modified to form attributes:
7--
8-- @
9-- defAttr `withForeColor` red
10-- @
11--
12-- Is the attribute that will set the foreground color to red and the background color to the
13-- default.
14--
15-- This can then be used to build an image wiht a red foreground like so:
16--
17-- @
18-- string (defAttr `withForeColor` red) "this text will be red"
19-- @
20--
21-- The default attributes set by 'defAttr' have a presentation determined by the terminal. This is
22-- not something VTY can control. The user is free to define the color scheme of the terminal as
23-- they see fit. Up to the limits of the terminal anyways.
24--
25-- The value 'currentAttr' will keep the attributes of whatever was output previously.
26--
27-- \todo This API is very verbose IMO. I'd like something more succinct.
28module Graphics.Vty.Attributes ( module Graphics.Vty.Attributes
29 , module Graphics.Vty.Attributes.Color
30 , module Graphics.Vty.Attributes.Color240
31 )
32 where
34import Data.Bits
35import Data.Default
36import Data.Monoid
37import Data.Word
39import Graphics.Vty.Attributes.Color
40import Graphics.Vty.Attributes.Color240
42-- | A display attribute defines the Color and Style of all the characters rendered after the
43-- attribute is applied.
44--
45-- At most 256 colors, picked from a 240 and 16 color palette, are possible for the background and
46-- foreground. The 240 colors and 16 colors are points in different palettes. See Color for more
47-- information.
48data Attr = Attr
49 { attrStyle :: !(MaybeDefault Style)
50 , attrForeColor :: !(MaybeDefault Color)
51 , attrBackColor :: !(MaybeDefault Color)
52 } deriving ( Eq, Show )
54-- This could be encoded into a single 32 bit word. The 32 bit word is first divided
55-- into 4 groups of 8 bits where: The first group codes what action should be taken with regards to
56-- the other groups.
57-- XXYYZZ__
58-- XX - style action
59-- 00 => reset to default
60-- 01 => unchanged
61-- 10 => set
62-- YY - foreground color action
63-- 00 => reset to default
64-- 01 => unchanged
65-- 10 => set
66-- ZZ - background color action
67-- 00 => reset to default
68-- 01 => unchanged
69-- 10 => set
70-- __ - unused
71--
72-- Next is the style flags
73-- SURBDO__
74-- S - standout
75-- U - underline
76-- R - reverse video
77-- B - blink
78-- D - dim
79-- O - bold
80-- __ - unused
81--
82-- Then the foreground color encoded into 8 bits.
83-- Then the background color encoded into 8 bits.
85instance Monoid Attr where
86 mempty = Attr mempty mempty mempty
87 mappend attr0 attr1 =
88 Attr ( attrStyle attr0 `mappend` attrStyle attr1 )
89 ( attrForeColor attr0 `mappend` attrForeColor attr1 )
90 ( attrBackColor attr0 `mappend` attrBackColor attr1 )
92-- | Specifies the display attributes such that the final style and color values do not depend on
93-- the previously applied display attribute. The display attributes can still depend on the
94-- terminal's default colors (unfortunately).
95data FixedAttr = FixedAttr
96 { fixedStyle :: !Style
97 , fixedForeColor :: !(Maybe Color)
98 , fixedBackColor :: !(Maybe Color)
99 } deriving ( Eq, Show )
101-- | The style and color attributes can either be the terminal defaults. Or be equivalent to the
102-- previously applied style. Or be a specific value.
103data MaybeDefault v where
104 Default :: MaybeDefault v
105 KeepCurrent :: MaybeDefault v
106 SetTo :: forall v . ( Eq v, Show v ) => !v -> MaybeDefault v
108deriving instance Eq v => Eq (MaybeDefault v)
109deriving instance Eq v => Show (MaybeDefault v)
111instance Eq v => Monoid ( MaybeDefault v ) where
112 mempty = KeepCurrent
113 mappend Default Default = Default
114 mappend Default KeepCurrent = Default
115 mappend Default ( SetTo v ) = SetTo v
116 mappend KeepCurrent Default = Default
117 mappend KeepCurrent KeepCurrent = KeepCurrent
118 mappend KeepCurrent ( SetTo v ) = SetTo v
119 mappend ( SetTo _v ) Default = Default
120 mappend ( SetTo v ) KeepCurrent = SetTo v
121 mappend ( SetTo _ ) ( SetTo v ) = SetTo v
123-- | Standard 8-color ANSI terminal color codes.
124black, red, green, yellow, blue, magenta, cyan, white :: Color
125black = ISOColor 0
126red = ISOColor 1
127green = ISOColor 2
128yellow = ISOColor 3
129blue = ISOColor 4
130magenta= ISOColor 5
131cyan = ISOColor 6
132white = ISOColor 7
134-- | Bright/Vivid variants of the standard 8-color ANSI
135brightBlack, brightRed, brightGreen, brightYellow :: Color
136brightBlue, brightMagenta, brightCyan, brightWhite :: Color
137brightBlack = ISOColor 8
138brightRed = ISOColor 9
139brightGreen = ISOColor 10
140brightYellow = ISOColor 11
141brightBlue = ISOColor 12
142brightMagenta= ISOColor 13
143brightCyan = ISOColor 14
144brightWhite = ISOColor 15
146-- | Styles are represented as an 8 bit word. Each bit in the word is 1 if the style attribute
147-- assigned to that bit should be applied and 0 if the style attribute should not be applied.
148type Style = Word8
150-- | The 6 possible style attributes:
151--
152-- * standout
153--
154-- * underline
155--
156-- * reverseVideo
157--
158-- * blink
159--
160-- * dim
161--
162-- * bold/bright
163--
164-- ( The invisible, protect, and altcharset display attributes some terminals support are not
165-- supported via VTY.)
166standout, underline, reverseVideo, blink, dim, bold :: Style
167standout = 0x01
168underline = 0x02
169reverseVideo = 0x04
170blink = 0x08
171dim = 0x10
172bold = 0x20
174defaultStyleMask :: Style
175defaultStyleMask = 0x00
177styleMask :: Attr -> Word8
178styleMask attr
179 = case attrStyle attr of
180 Default -> 0
181 KeepCurrent -> 0
182 SetTo v -> v
184-- | true if the given Style value has the specified Style set.
185hasStyle :: Style -> Style -> Bool
186hasStyle s bitMask = ( s .&. bitMask ) /= 0
188-- | Set the foreground color of an `Attr'.
189withForeColor :: Attr -> Color -> Attr
190withForeColor attr c = attr { attrForeColor = SetTo c }
192-- | Set the background color of an `Attr'.
193withBackColor :: Attr -> Color -> Attr
194withBackColor attr c = attr { attrBackColor = SetTo c }
196-- | Add the given style attribute
197withStyle :: Attr -> Style -> Attr
198withStyle attr styleFlag = attr { attrStyle = SetTo $ styleMask attr .|. styleFlag }
200-- | Sets the style, background color and foreground color to the default values for the terminal.
201-- There is no easy way to determine what the default background and foreground colors are.
202defAttr :: Attr
203defAttr = Attr Default Default Default
205instance Default Attr where
206 def = defAttr
208-- | Keeps the style, background color and foreground color that was previously set. Used to
209-- override some part of the previous style.
210--
211-- EG: current_style `withForeColor` brightMagenta
212--
213-- Would be the currently applied style (be it underline, bold, etc) but with the foreground color
214-- set to brightMagenta.
215currentAttr :: Attr
216currentAttr = Attr KeepCurrent KeepCurrent KeepCurrent