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