git.iko.soy/vty
on c384656 help sign in
vty/src/Graphics/Vty/DisplayAttributes.hs
162 lines 6.0 kB history raw
1-- Copyright 2009-2010 Corey O'Connor
2{-# LANGUAGE BangPatterns #-}
3{-# LANGUAGE CPP #-}
5module Graphics.Vty.DisplayAttributes where
7import Graphics.Vty.Attributes
9import Data.Bits ((.&.))
10import Data.ByteString (ByteString)
11#if !(MIN_VERSION_base(4,11,0))
12import Data.Semigroup (Semigroup(..))
13#endif
14import Data.Text (Text)
15import Data.Text.Encoding (encodeUtf8)
17-- | Given the previously applied display attributes as a FixedAttr and
18-- the current display attributes as an Attr produces a FixedAttr that
19-- represents the current display attributes. This is done by using the
20-- previously applied display attributes to remove the "KeepCurrent"
21-- abstraction.
22fixDisplayAttr :: FixedAttr -> Attr -> FixedAttr
23fixDisplayAttr fattr attr
24 = FixedAttr (fixStyle (fixedStyle fattr) (attrStyle attr))
25 (fixColor (fixedForeColor fattr) (attrForeColor attr))
26 (fixColor (fixedBackColor fattr) (attrBackColor attr))
27 (fixURL (fixedURL fattr) (attrURL attr))
28 where
29 fixStyle _s Default = defaultStyleMask
30 fixStyle s KeepCurrent = s
31 fixStyle _s (SetTo newStyle) = newStyle
32 fixColor _c Default = Nothing
33 fixColor c KeepCurrent = c
34 fixColor _c (SetTo c) = Just c
35 fixURL c KeepCurrent = c
36 fixURL _c (SetTo n) = Just n
37 fixURL _c Default = Nothing
39-- | difference between two display attributes. Used in the calculation
40-- of the operations required to go from one display attribute to the
41-- next.
42--
43-- Previously, vty would reset display attributes to default then apply
44-- the new display attributes. This turned out to be very expensive: A
45-- *lot* more data would be sent to the terminal than required.
46data DisplayAttrDiff = DisplayAttrDiff
47 { styleDiffs :: [StyleStateChange]
48 , foreColorDiff :: DisplayColorDiff
49 , backColorDiff :: DisplayColorDiff
50 , urlDiff :: URLDiff
51 }
52 deriving (Show)
54instance Semigroup DisplayAttrDiff where
55 d0 <> d1 =
56 let ds = simplifyStyleDiffs (styleDiffs d0) (styleDiffs d1)
57 fcd = simplifyColorDiffs (foreColorDiff d0) (foreColorDiff d1)
58 bcd = simplifyColorDiffs (backColorDiff d0) (backColorDiff d1)
59 ud = simplifyUrlDiffs (urlDiff d0) (urlDiff d1)
60 in DisplayAttrDiff ds fcd bcd ud
62instance Monoid DisplayAttrDiff where
63 mempty = DisplayAttrDiff [] NoColorChange NoColorChange NoLinkChange
64#if !(MIN_VERSION_base(4,11,0))
65 mappend = (<>)
66#endif
68-- | Used in the computation of a final style attribute change.
69simplifyStyleDiffs :: [StyleStateChange] -> [StyleStateChange] -> [StyleStateChange]
70simplifyStyleDiffs cs0 cs1 = cs0 `mappend` cs1
72-- | Consider two display color attributes diffs. What display color
73-- attribute diff are these equivalent to?
74simplifyColorDiffs :: DisplayColorDiff -> DisplayColorDiff -> DisplayColorDiff
75simplifyColorDiffs _cd ColorToDefault = ColorToDefault
76simplifyColorDiffs cd NoColorChange = cd
77simplifyColorDiffs _cd (SetColor !c) = SetColor c
79-- | Consider two URL changes, which are mostly going to be the latter
80-- unless the latter specifies no change.
81simplifyUrlDiffs :: URLDiff -> URLDiff -> URLDiff
82simplifyUrlDiffs ud NoLinkChange = ud
83simplifyUrlDiffs _ ud = ud
85-- | Difference between two display color attribute changes.
86data DisplayColorDiff
87 = ColorToDefault
88 | NoColorChange
89 | SetColor !Color
90 deriving (Show, Eq)
92-- | Style attribute changes are transformed into a sequence of
93-- apply/removes of the individual attributes.
94data StyleStateChange
95 = ApplyStandout
96 | RemoveStandout
97 | ApplyItalic
98 | RemoveItalic
99 | ApplyUnderline
100 | RemoveUnderline
101 | ApplyReverseVideo
102 | RemoveReverseVideo
103 | ApplyBlink
104 | RemoveBlink
105 | ApplyDim
106 | RemoveDim
107 | ApplyBold
108 | RemoveBold
109 deriving (Show, Eq)
111-- Setting and unsetting hyperlinks
112data URLDiff
113 = LinkTo !ByteString
114 | NoLinkChange
115 | EndLink
116 deriving (Show, Eq)
118-- | Determines the diff between two display&color attributes. This diff
119-- determines the operations that actually get output to the terminal.
120displayAttrDiffs :: FixedAttr -> FixedAttr -> DisplayAttrDiff
121displayAttrDiffs attr attr' = DisplayAttrDiff
122 { styleDiffs = diffStyles (fixedStyle attr) (fixedStyle attr')
123 , foreColorDiff = diffColor (fixedForeColor attr) (fixedForeColor attr')
124 , backColorDiff = diffColor (fixedBackColor attr) (fixedBackColor attr')
125 , urlDiff = diffURL (fixedURL attr) (fixedURL attr')
126 }
128diffURL :: Maybe Text -> Maybe Text -> URLDiff
129diffURL Nothing Nothing = NoLinkChange
130diffURL (Just _) Nothing = EndLink
131diffURL _ (Just url) = LinkTo (encodeUtf8 url)
133diffColor :: Maybe Color -> Maybe Color -> DisplayColorDiff
134diffColor Nothing (Just c') = SetColor c'
135diffColor (Just c) (Just c')
136 | c == c' = NoColorChange
137 | otherwise = SetColor c'
138diffColor Nothing Nothing = NoColorChange
139diffColor (Just _) Nothing = ColorToDefault
141diffStyles :: Style -> Style -> [StyleStateChange]
142diffStyles prev cur
143 = mconcat
144 [ styleDiff standout ApplyStandout RemoveStandout
145 , styleDiff underline ApplyUnderline RemoveUnderline
146 , styleDiff italic ApplyItalic RemoveItalic
147 , styleDiff reverseVideo ApplyReverseVideo RemoveReverseVideo
148 , styleDiff blink ApplyBlink RemoveBlink
149 , styleDiff dim ApplyDim RemoveDim
150 , styleDiff bold ApplyBold RemoveBold
151 ]
152 where
153 styleDiff s sm rm
154 = case (0 == prev .&. s, 0 == cur .&. s) of
155 -- not set in either
156 (True, True) -> []
157 -- set in both
158 (False, False) -> []
159 -- now set
160 (True, False) -> [sm]
161 -- now unset
162 (False, True) -> [rm]