on master help sign in
-
a9c1532coreyoconnor
src/Graphics/Vty/DisplayAttributes.hs+3−3
@@ -23,7 +23,7 @@ fix_display_attr fattr attr
23 fix_color c KeepCurrent = c
23 fix_color c KeepCurrent = c
24 fix_color _c (SetTo c) = Just c
24 fix_color _c (SetTo c) = Just c
25
25
26−data DisplayAttrDiffs = DisplayAttrDiffs
26+data DisplayAttrDiff = DisplayAttrDiff
27 { style_diffs :: [ StyleStateChange ]
27 { style_diffs :: [ StyleStateChange ]
28 , fore_color_diff :: DisplayColorDiff
28 , fore_color_diff :: DisplayColorDiff
29 , back_color_diff :: DisplayColorDiff
29 , back_color_diff :: DisplayColorDiff
@@ -49,8 +49,8 @@ data StyleStateChange
49 | ApplyBold
49 | ApplyBold
50 | RemoveBold
50 | RemoveBold
51
51
52−display_attr_diffs :: FixedAttr -> FixedAttr -> DisplayAttrDiffs
52+display_attr_diffs :: FixedAttr -> FixedAttr -> DisplayAttrDiff
53−display_attr_diffs attr attr' = DisplayAttrDiffs
53+display_attr_diffs attr attr' = DisplayAttrDiff
54 { style_diffs = diff_styles ( fixed_style attr ) ( fixed_style attr' )
54 { style_diffs = diff_styles ( fixed_style attr ) ( fixed_style attr' )
55 , fore_color_diff = diff_color ( fixed_fore_color attr ) ( fixed_fore_color attr' )
55 , fore_color_diff = diff_color ( fixed_fore_color attr ) ( fixed_fore_color attr' )
56 , back_color_diff = diff_color ( fixed_back_color attr ) ( fixed_back_color attr' )
56 , back_color_diff = diff_color ( fixed_back_color attr ) ( fixed_back_color attr' )
src/Graphics/Vty/Terminal/Generic.hs+9−6
@@ -38,9 +38,12 @@ new_terminal_handle :: forall t. Terminal t => t -> IO TerminalHandle
38new_terminal_handle t = liftM (TerminalHandle t) initial_terminal_state
38new_terminal_handle t = liftM (TerminalHandle t) initial_terminal_state
39
39
40data TerminalState = TerminalState
40data TerminalState = TerminalState
41+ { -- | The current terminal display attributes or Nothing if they are not known.
42+ current_attr :: Maybe FixedAttr
43+ }
41
44
42initial_terminal_state :: IO TerminalState
45initial_terminal_state :: IO TerminalState
43−initial_terminal_state = return $ TerminalState
46+initial_terminal_state = return $ TerminalState Nothing
44
47
45class Terminal t where
48class Terminal t where
46 -- | Text identifier for the terminal. Used for debugging.
49 -- | Text identifier for the terminal. Used for debugging.
@@ -50,7 +53,7 @@ class Terminal t where
50 -- | Clear the display and initialize the terminal to some initial display state.
53 -- | Clear the display and initialize the terminal to some initial display state.
51 --
54 --
52 -- The expectation of a program is that the display starts in some initial state.
55 -- The expectation of a program is that the display starts in some initial state.
53− -- The initial state would consist of fixed values
56+ -- The initial state would consist of fixed values:
54 -- - cursor at top left
57 -- - cursor at top left
55 -- - UTF-8 character encoding
58 -- - UTF-8 character encoding
56 -- - drawing characteristics are the default
59 -- - drawing characteristics are the default
@@ -58,7 +61,6 @@ class Terminal t where
58 -- access to a display such that:
61 -- access to a display such that:
59 -- - The previous state cannot be determined
62 -- - The previous state cannot be determined
60 -- - When exclusive access to a display is release the display returns to the previous state.
63 -- - When exclusive access to a display is release the display returns to the previous state.
61− --
62 reserve_display :: t -> IO ()
64 reserve_display :: t -> IO ()
63
65
64 -- | Return the display to the state before reserve_display
66 -- | Return the display to the state before reserve_display
@@ -136,8 +138,8 @@ class DisplayTerminal d where
136 -- attributes. In order to support this the currently applied display attributes are required.
138 -- attributes. In order to support this the currently applied display attributes are required.
137 -- In addition it may be possible to optimize the state changes based off the currently applied
139 -- In addition it may be possible to optimize the state changes based off the currently applied
138 -- display attributes.
140 -- display attributes.
139− attr_required_bytes :: d -> FixedAttr -> Attr -> DisplayAttrDiffs -> Word
141+ attr_required_bytes :: d -> FixedAttr -> Attr -> DisplayAttrDiff -> Word
140− serialize_set_attr :: d -> FixedAttr -> Attr -> DisplayAttrDiffs -> OutputBuffer -> IO OutputBuffer
142+ serialize_set_attr :: d -> FixedAttr -> Attr -> DisplayAttrDiff -> OutputBuffer -> IO OutputBuffer
141
143
142 -- | Reset the display attributes to the default display attributes
144 -- | Reset the display attributes to the default display attributes
143 default_attr_required_bytes :: d -> Word
145 default_attr_required_bytes :: d -> Word
@@ -315,7 +317,8 @@ serialize_span_op :: DisplayTerminal d
315serialize_span_op d (AttributeChange attr) out_ptr fattr = do
317serialize_span_op d (AttributeChange attr) out_ptr fattr = do
316 let attr' = limit_attr_for_display d attr
318 let attr' = limit_attr_for_display d attr
317 fattr' = fix_display_attr fattr attr'
319 fattr' = fix_display_attr fattr attr'
320+ diffs = display_attr_diffs fattr fattr'
318− out_ptr' <- serialize_set_attr d fattr attr' (display_attr_diffs fattr fattr') out_ptr
321+ out_ptr' <- serialize_set_attr d fattr attr' diffs out_ptr
319 return (out_ptr', fattr')
322 return (out_ptr', fattr')
320serialize_span_op _d (TextSpan _ _ str) out_ptr fattr = do
323serialize_span_op _d (TextSpan _ _ str) out_ptr fattr = do
321 out_ptr' <- serialize_utf8_text str out_ptr
324 out_ptr' <- serialize_utf8_text str out_ptr
test/interactive_terminal_test.hs−1
@@ -852,7 +852,6 @@ inline_test_0 = Test
852 , test_ID = "inline_test_0"
852 , test_ID = "inline_test_0"
853 , test_action = do
853 , test_action = do
854 t <- terminal_handle
854 t <- terminal_handle
855− d <- display_bounds t >>= display_context t
856 putStrLn "line 0."
855 putStrLn "line 0."
857 put_attr_change t $ back_color red >> style underline
856 put_attr_change t $ back_color red >> style underline
858 putStrLn "line 1."
857 putStrLn "line 1."