git.iko.soy/vty
on master help sign in
-
f3f6af5coreyoconnor
src/Graphics/Vty/AttributeChange.hs+6−8
compare with master
unifiedsplit
@@ -8,20 +8,18 @@ import Graphics.Vty.Terminal.Generic
8
8
9import Control.Monad.State.Strict
9import Control.Monad.State.Strict
10
10
11−data ChangeState = ChangeState
12− { change_sequence :: ()
13− }
14−
15−type AttrChange v = State ChangeState v
11+type AttrChange v = State DisplayAttrDiff v
16
12
17back_color :: Color -> AttrChange ()
13back_color :: Color -> AttrChange ()
18−back_color c = return ()
14+back_color c = modify $ \ChangeState cs -> cs `mappend` [ DisplayAttrDiff [] NoColorChange ( SetTo c ) ]
19
15
20style :: Style -> AttrChange ()
16style :: Style -> AttrChange ()
21−style s = return ()
17+style s = modify $ \ChangeState cs -> cs `mappend` [ DisplayAttrDiff NoColorChange NoColorChange ]
18+
19+diff_styles :: Style -> Style -> [StyleStateChange]
22
20
23default_all :: AttrChange ()
21default_all :: AttrChange ()
24−default_all = return ()
22+default_all = modify $ \ChangeState cs -> cs `mappend` [ DisplayAttrDiff remove_all_styles ColorToDefault ColorToDefault ]
25
23
26put_attr_change :: TerminalHandle -> AttrChange () -> IO ()
24put_attr_change :: TerminalHandle -> AttrChange () -> IO ()
27put_attr_change t c = do
25put_attr_change t c = do
src/Graphics/Vty/DisplayAttributes.hs+17−1
@@ -1,10 +1,11 @@
1+{-# LANGUAGE BangPatterns #-}
1module Graphics.Vty.DisplayAttributes
2module Graphics.Vty.DisplayAttributes
2 where
3 where
3
4
4import Graphics.Vty.Attributes
5import Graphics.Vty.Attributes
5
6
6import Data.Bits ( (.&.) )
7import Data.Bits ( (.&.) )
7−import Data.Monoid ( mconcat )
8+import Data.Monoid ( Monoid(..), mconcat )
8
9
9-- | Given the previously applied display attributes as a FixedAttr and the current display
10-- | Given the previously applied display attributes as a FixedAttr and the current display
10-- attributes as an Attr produces a FixedAttr that represents the current display attributes. This
11-- attributes as an Attr produces a FixedAttr that represents the current display attributes. This
@@ -29,6 +30,21 @@ data DisplayAttrDiff = DisplayAttrDiff
29 , back_color_diff :: DisplayColorDiff
30 , back_color_diff :: DisplayColorDiff
30 }
31 }
31
32
33+instance Monoid DisplayAttrDiff where
34+ mempty = DisplayAttrDiff [] NoColorChange NoColorChange
35+ mappend d_0 d_1 =
36+ let ds = simplify_style_diffs ( style_diffs d_0 ) ( style_diffs d_1 )
37+ fcd = simplify_color_diffs ( fore_color_diff d_0 ) ( fore_color_diff d_1 )
38+ bcd = simplify_color_diffs ( back_color_diff d_0 ) ( back_color_diff d_1 )
39+ in DisplayAttrDiff ds fcd bcd
40+
41+simplify_style_diffs :: [ StyleStateChange ] -> [ StyleStateChange ] -> [ StyleStateChange ]
42+simplify_style_diffs cs_0 cs_1 = cs_0 `mappend` cs_1
43+
44+simplify_color_diffs _cd ColorToDefault = ColorToDefault
45+simplify_color_diffs cd NoColorChange = cd
46+simplify_color_diffs _cd ( SetColor !c ) = SetColor c
47+
32data DisplayColorDiff
48data DisplayColorDiff
33 = ColorToDefault
49 = ColorToDefault
34 | NoColorChange
50 | NoColorChange
test/Makefile+2−1
@@ -1,6 +1,7 @@
1VERIF_TESTS := \
1VERIF_TESTS := \
2verify_attribute_ops \
2verify_attribute_ops \
3−verify_control_strings \
3+verify_display_attributes \
4+verify_parse_terminfo_caps \
4verify_utf8_width \
5verify_utf8_width \
5verify_image_ops \
6verify_image_ops \
6verify_image_trans \
7verify_image_trans \
test/Verify/Graphics/Vty/DisplayAttributes.hsnew file+8
@@ -0,0 +1,8 @@
1+module Verify.Graphics.Vty.DisplayAttributes ( module Verify.Graphics.Vty.DisplayAttributes
2+ , module Graphics.Vty.DisplayAttributes
3+ )
4+ where
5+
6+import Graphics.Vty.DisplayAttributes
7+import Verify
8+
test/verify_display_attributes.hsnew file+9
@@ -0,0 +1,9 @@
1+module Main where
2+
3+import Verify.Graphics.Vty.DisplayAttributes
4+import Verify.Graphics.Vty.Attributes
5+
6+import Verify
7+
8+main = run_test $ do
9+ return ()
test/verify_control_strings.hs → test/verify_parse_terminfo_caps.hsrenamed

The content is the same.