git.iko.soy/vty
on 03cc712 help sign in
vty/src/Graphics/Vty/DisplayAttributes.hs
125 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.
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 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 { styleDiffs :: [StyleStateChange]
36 , foreColorDiff :: DisplayColorDiff
37 , backColorDiff :: DisplayColorDiff
38 }
39 deriving (Show)
41instance Monoid DisplayAttrDiff where
42 mempty = DisplayAttrDiff [] NoColorChange NoColorChange
43 mappend d0 d1 =
44 let ds = simplifyStyleDiffs (styleDiffs d0) (styleDiffs d1)
45 fcd = simplifyColorDiffs (foreColorDiff d0) (foreColorDiff d1)
46 bcd = simplifyColorDiffs (backColorDiff d0) (backColorDiff d1)
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.
52simplifyStyleDiffs :: [StyleStateChange] -> [StyleStateChange] -> [StyleStateChange]
53simplifyStyleDiffs cs0 cs1 = cs0 `mappend` cs1
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.
59simplifyColorDiffs :: DisplayColorDiff -> DisplayColorDiff -> DisplayColorDiff
60simplifyColorDiffs _cd ColorToDefault = ColorToDefault
61simplifyColorDiffs cd NoColorChange = cd
62simplifyColorDiffs _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.
90displayAttrDiffs :: FixedAttr -> FixedAttr -> DisplayAttrDiff
91displayAttrDiffs attr attr' = DisplayAttrDiff
92 { styleDiffs = diffStyles (fixedStyle attr) (fixedStyle attr')
93 , foreColorDiff = diffColor (fixedForeColor attr) (fixedForeColor attr')
94 , backColorDiff = diffColor (fixedBackColor attr) (fixedBackColor attr')
95 }
97diffColor :: Maybe Color -> Maybe Color -> DisplayColorDiff
98diffColor Nothing (Just c') = SetColor c'
99diffColor (Just c) (Just c')
100 | c == c' = NoColorChange
101 | otherwise = SetColor c'
102diffColor Nothing Nothing = NoColorChange
103diffColor (Just _) Nothing = ColorToDefault
105diffStyles :: Style -> Style -> [StyleStateChange]
106diffStyles prev cur
107 = mconcat
108 [ styleDiff standout ApplyStandout RemoveStandout
109 , styleDiff underline ApplyUnderline RemoveUnderline
110 , styleDiff reverseVideo ApplyReverseVideo RemoveReverseVideo
111 , styleDiff blink ApplyBlink RemoveBlink
112 , styleDiff dim ApplyDim RemoveDim
113 , styleDiff bold ApplyBold RemoveBold
114 ]
115 where
116 styleDiff 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]