git.iko.soy/vty
on ca2aea7 help sign in
vty/src/Graphics/Vty/Terminal/XTermColor.hs
79 lines 2.7 kB history raw
1-- Copyright 2009 Corey O'Connor
2{-# LANGUAGE ForeignFunctionInterface #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4{-# LANGUAGE MagicHash #-}
5{-# LANGUAGE FlexibleInstances #-}
6{-# LANGUAGE TypeFamilies #-}
7module Graphics.Vty.Terminal.XTermColor ( terminal_instance
8 )
9 where
11import Graphics.Vty.Terminal.Generic
12import qualified Graphics.Vty.Terminal.TerminfoBased as TerminfoBased
14import System.IO
16data XTermColor = XTermColor
17 { xterm_variant :: String
18 , super_term :: TerminalHandle
19 }
21-- Initialize the display to UTF-8
22-- Regardless of what is output the text encoding is assumed to be UTF-8
23terminal_instance :: String -> IO XTermColor
24terminal_instance variant = do
25 flushed_put set_utf8_char_set
26 t <- TerminfoBased.terminal_instance variant >>= new_terminal_handle
27 return $ XTermColor variant t
29flushed_put :: String -> IO ()
30flushed_put str = do
31 hPutStr stdout str
32 hFlush stdout
34-- Since I don't know of a terminfo string cap that produces these strings these are hardcoded.
35set_utf8_char_set, set_default_char_set :: String
36set_utf8_char_set = "\ESC%G"
37set_default_char_set = "\ESC%@"
39instance Terminal XTermColor where
40 terminal_ID t = (show $ xterm_variant t) ++ " :: XTermColor"
42 release_terminal t = do
43 flushed_put set_default_char_set
44 release_terminal $ super_term t
46 reserve_display t = reserve_display (super_term t)
48 release_display t = release_display (super_term t)
50 display_terminal_instance t b c = do
51 d <- display_context (super_term t) b
52 return $ c (DisplayContext d)
54 display_bounds t = display_bounds (super_term t)
56 output_byte_buffer t = output_byte_buffer (super_term t)
58data DisplayContext = DisplayContext
59 { super_display :: DisplayHandle
60 }
62instance DisplayTerminal DisplayContext where
63 context_region d = context_region (super_display d)
65 move_cursor_required_bytes d = move_cursor_required_bytes (super_display d)
66 serialize_move_cursor d = serialize_move_cursor (super_display d)
68 show_cursor_required_bytes d = show_cursor_required_bytes (super_display d)
69 serialize_show_cursor d = serialize_show_cursor (super_display d)
71 hide_cursor_required_bytes d = hide_cursor_required_bytes (super_display d)
72 serialize_hide_cursor d = serialize_hide_cursor (super_display d)
74 attr_required_bytes d = attr_required_bytes (super_display d)
75 serialize_set_attr d = serialize_set_attr (super_display d)
77 default_attr_required_bytes d = default_attr_required_bytes (super_display d)
78 serialize_default_attr d = serialize_default_attr (super_display d)