dbc218c · vty · git.iko.soy

src/Graphics/Vty/Inline.hs+4

compare with master

unifiedsplit

@@ -16,6 +16,8 @@ import qualified Data.String.UTF8 as UTF8

16import Data.IORef

17import Data.Monoid ( mappend )

18

19+import System.IO

20+

19type InlineM v = State Attr v

21type InlineM v = State Attr v

20

22

21back_color :: Color -> InlineM ()

23back_color :: Color -> InlineM ()

@@ -52,6 +54,7 @@ put_attr_change t c = do

52 attr' = limit_attr_for_display d attr

54 attr' = limit_attr_for_display d attr

53 fattr' = fix_display_attr fattr attr'

55 fattr' = fix_display_attr fattr attr'

54 diffs = display_attr_diffs fattr fattr'

56 diffs = display_attr_diffs fattr fattr'

57+ liftIO $ hFlush stdout

55 liftIO $ marshall_to_terminal t ( attr_required_bytes d fattr attr' diffs )

58 liftIO $ marshall_to_terminal t ( attr_required_bytes d fattr attr' diffs )

56 ( serialize_set_attr d fattr attr' diffs )

59 ( serialize_set_attr d fattr attr' diffs )

57 liftIO $ modifyIORef ( state_ref t ) $ \s -> s { known_fattr = Just fattr' }

60 liftIO $ modifyIORef ( state_ref t ) $ \s -> s { known_fattr = Just fattr' }

@@ -60,6 +63,7 @@ put_attr_change t c = do

60put_string :: ( Applicative m, MonadIO m ) => TerminalHandle -> String -> m ()

63put_string :: ( Applicative m, MonadIO m ) => TerminalHandle -> String -> m ()

61put_string t s = do

64put_string t s = do

62 let s_utf8 = UTF8.fromString s

65 let s_utf8 = UTF8.fromString s

66+ liftIO $ hFlush stdout

63 liftIO $ marshall_to_terminal t ( utf8_text_required_bytes s_utf8)

67 liftIO $ marshall_to_terminal t ( utf8_text_required_bytes s_utf8)

64 ( serialize_utf8_text s_utf8 )

68 ( serialize_utf8_text s_utf8 )

65

69

src/Graphics/Vty/Terminal/TerminfoBased.hs+3−1

@@ -146,6 +146,7 @@ instance Terminal Term where

146 -- Screen on OS X does not appear to support smcup?

147 -- To approximate the expected behavior: clear the screen and then move the mouse to the

148 -- home position.

149+ liftIO $ hFlush stdout

149 liftIO $ marshall_cap_to_terminal t clear_screen []

150 liftIO $ marshall_cap_to_terminal t clear_screen []

150 return ()

151 return ()

151

152

@@ -171,9 +172,10 @@ instance Terminal Term where

171

172

172 -- Output the byte buffer of the specified size to the terminal device.

173 -- Output the byte buffer of the specified size to the terminal device.

173 output_byte_buffer t out_ptr out_byte_count = do

174 output_byte_buffer t out_ptr out_byte_count = do

175+ -- if the out fd is actually the same as stdout's then a

174 -- flush is required *before* the c_output_byte_buffer call

176 -- flush is required *before* the c_output_byte_buffer call

175 -- otherwise there may still be data in GHC's internal stdout buffer.

177 -- otherwise there may still be data in GHC's internal stdout buffer.

176− hFlush stdout

178+ -- _ <- handleToFd stdout

177 let Fd c_fd = term_fd t

179 let Fd c_fd = term_fd t

178 if out_byte_count /= 0

180 if out_byte_count /= 0

179 then c_output_byte_buffer c_fd out_ptr ( toEnum $! fromEnum out_byte_count )

181 then c_output_byte_buffer c_fd out_ptr ( toEnum $! fromEnum out_byte_count )

src/Graphics/Vty/Terminal/XTermColor.hs+8−3

@@ -14,6 +14,8 @@ import qualified Graphics.Vty.Terminal.TerminfoBased as TerminfoBased

14import Control.Applicative

15import Control.Monad.Trans

16

17+import qualified Data.String.UTF8 as UTF8

18+

17import System.IO

19import System.IO

18

20

19data XTermColor = XTermColor

21data XTermColor = XTermColor

@@ -88,7 +90,10 @@ instance DisplayTerminal DisplayContext where

88 -- I think xterm is broken: Reseting the background color as the first bytes serialized on a new

90 -- I think xterm is broken: Reseting the background color as the first bytes serialized on a new

89 -- line does not effect the background color xterm uses to clear the line. Which is used *after*

91 -- line does not effect the background color xterm uses to clear the line. Which is used *after*

90 -- the next newline.

92 -- the next newline.

91− inline_hack _d = do

93+ inline_hack d = do

92− liftIO $ hPutStr stdout "\ESC[K"

94+ let t = case super_display d of

93− liftIO $ hFlush stdout

95+ DisplayHandle _ t_ _ -> t_

96+ let s_utf8 = UTF8.fromString "\ESC[K"

97+ liftIO $ marshall_to_terminal t ( utf8_text_required_bytes s_utf8)

98+ ( serialize_utf8_text s_utf8 )

94

99

test/Makefile+1−1

@@ -26,7 +26,7 @@ $(VERIF_TESTS)

26$(shell mkdir -p objects )

27

28# TODO: Tests should also be buildable referencing the currently installed vty

29−GHC_ARGS=--make -i../src -package parallel -package deepseq-1.1.0.0 -hide-package transformers -hide-package monads-fd -hide-package monads-tf -package QuickCheck-2.1.0.3 -ignore-package vty ../cbits/gwinsz.c ../cbits/output_buffer.c ../cbits/set_term_timing.c ../cbits/mk_wcwidth.c -O -funbox-strict-fields -Wall -threaded -fno-full-laziness -fspec-constr -odir objects -hidir objects

29+GHC_ARGS=--make -i../src -package parallel -package deepseq-1.1.0.0 -hide-package transformers -hide-package monads-fd -hide-package monads-tf -package QuickCheck-2.1.1.1 -ignore-package vty ../cbits/gwinsz.c ../cbits/output_buffer.c ../cbits/set_term_timing.c ../cbits/mk_wcwidth.c -O -funbox-strict-fields -Wall -threaded -fno-full-laziness -fspec-constr -odir objects -hidir objects

30

31GHC_PROF_ARGS=-prof -auto-all $(GHC_ARGS)

32

test/interactive_terminal_test.hs+4

@@ -238,8 +238,10 @@ display_bounds_test_1 = Test

238 forM_ [1 .. h - 2] $ \y -> do

239 set_cursor_pos t 0 y

240 putStr "X"

241+ hFlush stdout

241 set_cursor_pos t (w - 1) y

242 set_cursor_pos t (w - 1) y

242 putStr "X"

243 putStr "X"

244+ hFlush stdout

243 set_cursor_pos t 0 (h - 1)

245 set_cursor_pos t 0 (h - 1)

244 let row_h = replicate (fromEnum w - 1) 'X'

246 let row_h = replicate (fromEnum w - 1) 'X'

245 putStr row_h

247 putStr row_h

@@ -289,8 +291,10 @@ display_bounds_test_3 = Test

289 forM_ [1 .. h - 2] $ \y -> do

291 forM_ [1 .. h - 2] $ \y -> do

290 set_cursor_pos t 0 y

292 set_cursor_pos t 0 y

291 putStr "X"

293 putStr "X"

294+ hFlush stdout

292 set_cursor_pos t (w - 1) y

295 set_cursor_pos t (w - 1) y

293 putStr "X"

296 putStr "X"

297+ hFlush stdout

294 set_cursor_pos t 0 (h - 1)

298 set_cursor_pos t 0 (h - 1)

295 let row_h = row_0

299 let row_h = row_0

296 putStr row_h

300 putStr row_h