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