git.iko.soy/vty
on 00a6a4f help sign in
vty/src/Graphics/Vty/Output/XTermColor.hs
53 lines 2.0 kB history raw
1-- Copyright 2009-2010 Corey O'Connor
2module Graphics.Vty.Output.XTermColor ( reserve_terminal )
3 where
5import Graphics.Vty.Output.Interface
6import qualified Graphics.Vty.Output.TerminfoBased as TerminfoBased
8import Control.Applicative
9import Control.Monad.Trans
11import qualified Data.Text as T
12import qualified Data.Text.Encoding as T
14import System.IO
16-- | Initialize the display to UTF-8.
17reserve_terminal :: ( Applicative m, MonadIO m ) => String -> Handle -> m Output
18reserve_terminal variant out_handle = liftIO $ do
19 let flushed_put str = do
20 hPutStr out_handle str
21 hFlush out_handle
22 -- If the terminal variant is xterm-color use xterm instead since, more often than not,
23 -- xterm-color is broken.
24 let variant' = if variant == "xterm-color" then "xterm" else variant
25 flushed_put set_utf8_char_set
26 t <- TerminfoBased.reserve_terminal variant' out_handle
27 let t' = t
28 { terminal_ID = terminal_ID t ++ " (xterm-color)"
29 , release_terminal = do
30 liftIO $ flushed_put set_default_char_set
31 release_terminal t
32 , mk_display_context = \t_actual r -> do
33 dc <- mk_display_context t t_actual r
34 return $ dc { inline_hack = xterm_inline_hack t' }
35 }
36 return t'
38-- | These sequences set xterm based terminals to UTF-8 output.
39--
40-- \todo I don't know of a terminfo cap that is equivalent to this.
41set_utf8_char_set, set_default_char_set :: String
42set_utf8_char_set = "\ESC%G"
43set_default_char_set = "\ESC%@"
45-- | I think xterm is broken: Reseting the background color as the first bytes serialized on a
46-- new line does not effect the background color xterm uses to clear the line. Which is used
47-- *after* the next newline.
48xterm_inline_hack :: Output -> IO ()
49xterm_inline_hack t = do
50 let s_utf8 = T.encodeUtf8 $ T.pack "\ESC[K"
51 send_to_terminal t (utf8_text_required_bytes s_utf8)
52 (serialize_utf8_text s_utf8)