git.iko.soy/vty
on cceeeee help sign in
vty/src/Graphics/Vty/DisplayAttributes.hs
134 lines 5.0 kB history raw
1-- Copyright 2009-2010 Corey O'Connor
2{-# LANGUAGE CPP #-}
3{-# LANGUAGE BangPatterns #-}
5#ifndef MIN_VERSION_base
6#defined MIN_VERSION_base(x,y,z) 1
7#endif
9module Graphics.Vty.DisplayAttributes
10 where
12import Graphics.Vty.Attributes
14import Data.Bits ((.&.))
16#if !(MIN_VERSION_base(4,8,0))
17import Data.Monoid (Monoid(..), mconcat)
18#endif
20-- | Given the previously applied display attributes as a FixedAttr and the current display
21-- attributes as an Attr produces a FixedAttr that represents the current display attributes. This
22-- is done by using the previously applied display attributes to remove the "KeepCurrent"
23-- abstraction.
24fixDisplayAttr :: FixedAttr -> Attr -> FixedAttr
25fixDisplayAttr fattr attr
26 = FixedAttr (fixStyle (fixedStyle fattr) (attrStyle attr))
27 (fixColor (fixedForeColor fattr) (attrForeColor attr))
28 (fixColor (fixedBackColor fattr) (attrBackColor attr))
29 where
30 fixStyle _s Default = defaultStyleMask
31 fixStyle s KeepCurrent = s
32 fixStyle _s (SetTo newStyle) = newStyle
33 fixColor _c Default = Nothing
34 fixColor c KeepCurrent = c
35 fixColor _c (SetTo c) = Just c
37-- | difference between two display attributes. Used in the calculation of the operations required
38-- to go from one display attribute to the next.
39--
40-- Previously, vty would reset display attributes to default then apply the new display attributes.
41-- This turned out to be very expensive: A *lot* more data would be sent to the terminal than
42-- required.
43data DisplayAttrDiff = DisplayAttrDiff
44 { styleDiffs :: [StyleStateChange]
45 , foreColorDiff :: DisplayColorDiff
46 , backColorDiff :: DisplayColorDiff
47 }
48 deriving (Show)
50instance Monoid DisplayAttrDiff where
51 mempty = DisplayAttrDiff [] NoColorChange NoColorChange
52 mappend d0 d1 =
53 let ds = simplifyStyleDiffs (styleDiffs d0) (styleDiffs d1)
54 fcd = simplifyColorDiffs (foreColorDiff d0) (foreColorDiff d1)
55 bcd = simplifyColorDiffs (backColorDiff d0) (backColorDiff d1)
56 in DisplayAttrDiff ds fcd bcd
58-- | Used in the computation of a final style attribute change.
59--
60-- TODO(corey): not really a simplify but a monoid instance.
61simplifyStyleDiffs :: [StyleStateChange] -> [StyleStateChange] -> [StyleStateChange]
62simplifyStyleDiffs cs0 cs1 = cs0 `mappend` cs1
64-- | Consider two display color attributes diffs. What display color attribute diff are these
65-- equivalent to?
66--
67-- TODO(corey): not really a simplify but a monoid instance.
68simplifyColorDiffs :: DisplayColorDiff -> DisplayColorDiff -> DisplayColorDiff
69simplifyColorDiffs _cd ColorToDefault = ColorToDefault
70simplifyColorDiffs cd NoColorChange = cd
71simplifyColorDiffs _cd (SetColor !c) = SetColor c
73-- | Difference between two display color attribute changes.
74data DisplayColorDiff
75 = ColorToDefault
76 | NoColorChange
77 | SetColor !Color
78 deriving (Show, Eq)
80-- | Style attribute changes are transformed into a sequence of apply/removes of the individual
81-- attributes.
82data StyleStateChange
83 = ApplyStandout
84 | RemoveStandout
85 | ApplyUnderline
86 | RemoveUnderline
87 | ApplyReverseVideo
88 | RemoveReverseVideo
89 | ApplyBlink
90 | RemoveBlink
91 | ApplyDim
92 | RemoveDim
93 | ApplyBold
94 | RemoveBold
95 deriving (Show, Eq)
97-- | Determines the diff between two display&color attributes. This diff determines the operations
98-- that actually get output to the terminal.
99displayAttrDiffs :: FixedAttr -> FixedAttr -> DisplayAttrDiff
100displayAttrDiffs attr attr' = DisplayAttrDiff
101 { styleDiffs = diffStyles (fixedStyle attr) (fixedStyle attr')
102 , foreColorDiff = diffColor (fixedForeColor attr) (fixedForeColor attr')
103 , backColorDiff = diffColor (fixedBackColor attr) (fixedBackColor attr')
104 }
106diffColor :: Maybe Color -> Maybe Color -> DisplayColorDiff
107diffColor Nothing (Just c') = SetColor c'
108diffColor (Just c) (Just c')
109 | c == c' = NoColorChange
110 | otherwise = SetColor c'
111diffColor Nothing Nothing = NoColorChange
112diffColor (Just _) Nothing = ColorToDefault
114diffStyles :: Style -> Style -> [StyleStateChange]
115diffStyles prev cur
116 = mconcat
117 [ styleDiff standout ApplyStandout RemoveStandout
118 , styleDiff underline ApplyUnderline RemoveUnderline
119 , styleDiff reverseVideo ApplyReverseVideo RemoveReverseVideo
120 , styleDiff blink ApplyBlink RemoveBlink
121 , styleDiff dim ApplyDim RemoveDim
122 , styleDiff bold ApplyBold RemoveBold
123 ]
124 where
125 styleDiff s sm rm
126 = case (0 == prev .&. s, 0 == cur .&. s) of
127 -- not set in either
128 (True, True) -> []
129 -- set in both
130 (False, False) -> []
131 -- now set
132 (True, False) -> [sm]
133 -- now unset
134 (False, True) -> [rm]