git.iko.soy/vty
on 207c508 help sign in
vty/src/Graphics/Vty/DisplayAttributes.hs
126 lines 4.9 kB history raw
1-- Copyright 2009-2010 Corey O'Connor
2{-# LANGUAGE BangPatterns #-}
3module Graphics.Vty.DisplayAttributes
4 where
6import Graphics.Vty.Attributes
8import Data.Bits ( (.&.) )
9import Data.Monoid ( Monoid(..), mconcat )
11-- | Given the previously applied display attributes as a FixedAttr and the current display
12-- attributes as an Attr produces a FixedAttr that represents the current display attributes. This
13-- is done by using the previously applied display attributes to remove the "KeepCurrent"
14-- abstraction.
15fix_display_attr :: FixedAttr -> Attr -> FixedAttr
16fix_display_attr fattr attr
17 = FixedAttr ( fix_style (fixed_style fattr) (attr_style attr) )
18 ( fix_color (fixed_fore_color fattr) (attr_fore_color attr) )
19 ( fix_color (fixed_back_color fattr) (attr_back_color attr) )
20 where
21 fix_style _s Default = default_style_mask
22 fix_style s KeepCurrent = s
23 fix_style _s (SetTo new_style) = new_style
24 fix_color _c Default = Nothing
25 fix_color c KeepCurrent = c
26 fix_color _c (SetTo c) = Just c
28-- | difference between two display attributes. Used in the calculation of the operations required
29-- to go from one display attribute to the next.
30--
31-- Previously, vty would reset display attributes to default then apply the new display attributes.
32-- This turned out to be very expensive: A *lot* more data would be sent to the terminal than
33-- required.
34data DisplayAttrDiff = DisplayAttrDiff
35 { style_diffs :: [ StyleStateChange ]
36 , fore_color_diff :: DisplayColorDiff
37 , back_color_diff :: DisplayColorDiff
38 }
39 deriving ( Show )
41instance Monoid DisplayAttrDiff where
42 mempty = DisplayAttrDiff [] NoColorChange NoColorChange
43 mappend d_0 d_1 =
44 let ds = simplify_style_diffs ( style_diffs d_0 ) ( style_diffs d_1 )
45 fcd = simplify_color_diffs ( fore_color_diff d_0 ) ( fore_color_diff d_1 )
46 bcd = simplify_color_diffs ( back_color_diff d_0 ) ( back_color_diff d_1 )
47 in DisplayAttrDiff ds fcd bcd
49-- | Used in the computation of a final style attribute change.
50--
51-- TODO(corey): not really a simplify but a monoid instance.
52simplify_style_diffs :: [ StyleStateChange ] -> [ StyleStateChange ] -> [ StyleStateChange ]
53simplify_style_diffs cs_0 cs_1 = cs_0 `mappend` cs_1
55-- | Consider two display color attributes diffs. What display color attribute diff are these
56-- equivalent to?
57--
58-- TODO(corey): not really a simplify but a monoid instance.
59simplify_color_diffs :: DisplayColorDiff -> DisplayColorDiff -> DisplayColorDiff
60simplify_color_diffs _cd ColorToDefault = ColorToDefault
61simplify_color_diffs cd NoColorChange = cd
62simplify_color_diffs _cd ( SetColor !c ) = SetColor c
64-- | Difference between two display color attribute changes.
65data DisplayColorDiff
66 = ColorToDefault
67 | NoColorChange
68 | SetColor !Color
69 deriving ( Show, Eq )
71-- | Style attribute changes are transformed into a sequence of apply/removes of the individual
72-- attributes.
73data StyleStateChange
74 = ApplyStandout
75 | RemoveStandout
76 | ApplyUnderline
77 | RemoveUnderline
78 | ApplyReverseVideo
79 | RemoveReverseVideo
80 | ApplyBlink
81 | RemoveBlink
82 | ApplyDim
83 | RemoveDim
84 | ApplyBold
85 | RemoveBold
86 deriving ( Show, Eq )
88-- | Determines the diff between two display&color attributes. This diff determines the operations
89-- that actually get output to the terminal.
90display_attr_diffs :: FixedAttr -> FixedAttr -> DisplayAttrDiff
91display_attr_diffs attr attr' = DisplayAttrDiff
92 { style_diffs = diff_styles ( fixed_style attr ) ( fixed_style attr' )
93 , fore_color_diff = diff_color ( fixed_fore_color attr ) ( fixed_fore_color attr' )
94 , back_color_diff = diff_color ( fixed_back_color attr ) ( fixed_back_color attr' )
95 }
97diff_color :: Maybe Color -> Maybe Color -> DisplayColorDiff
98diff_color Nothing (Just c') = SetColor c'
99diff_color (Just c) (Just c')
100 | c == c' = NoColorChange
101 | otherwise = SetColor c'
102diff_color Nothing Nothing = NoColorChange
103diff_color (Just _) Nothing = ColorToDefault
105diff_styles :: Style -> Style -> [StyleStateChange]
106diff_styles prev cur
107 = mconcat
108 [ style_diff standout ApplyStandout RemoveStandout
109 , style_diff underline ApplyUnderline RemoveUnderline
110 , style_diff reverse_video ApplyReverseVideo RemoveReverseVideo
111 , style_diff blink ApplyBlink RemoveBlink
112 , style_diff dim ApplyDim RemoveDim
113 , style_diff bold ApplyBold RemoveBold
114 ]
115 where
116 style_diff s sm rm
117 = case ( 0 == prev .&. s, 0 == cur .&. s ) of
118 -- not set in either
119 ( True, True ) -> []
120 -- set in both
121 ( False, False ) -> []
122 -- now set
123 ( True, False) -> [ sm ]
124 -- now unset
125 ( False, True) -> [ rm ]