git.iko.soy/vty
on ae06339 help sign in
vty/src/Graphics/Vty/Terminal/MacOSX.hs
97 lines 3.3 kB history raw
1-- Copyright 2009-2010 Corey O'Connor
2-- The standard Mac OS X terminals Terminal.app and iTerm both declare themselves to be
3-- "xterm-color" by default. However the terminfo database for xterm-color included with OS X is
4-- incomplete.
5--
6-- This terminal implementation modifies the standard terminfo terminal as required for complete OS
7-- X support.
8{-# LANGUAGE ForeignFunctionInterface #-}
9{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE MagicHash #-}
11{-# LANGUAGE FlexibleInstances #-}
12{-# LANGUAGE TypeFamilies #-}
13module Graphics.Vty.Terminal.MacOSX ( terminal_instance
14 )
15 where
17import Graphics.Vty.Terminal.Generic
18import qualified Graphics.Vty.Terminal.TerminfoBased as TerminfoBased
20import Control.Applicative
21import Control.Monad.Trans
23import System.IO
25data Term = Term
26 { super_term :: TerminalHandle
27 , term_app :: String
28 }
30-- for Terminal.app use "xterm". For iTerm.app use "xterm-256color"
31terminal_instance :: ( Applicative m, MonadIO m ) => String -> m Term
32terminal_instance v = do
33 let base_term "iTerm.app" = "xterm-256color"
34 base_term _ = "xterm"
35 t <- TerminfoBased.terminal_instance (base_term v) >>= new_terminal_handle
36 return $ Term t v
38flushed_put :: MonadIO m => String -> m ()
39flushed_put str = do
40 liftIO $ hPutStr stdout str
41 liftIO $ hFlush stdout
43-- Terminal.app really does want the xterm-color smcup and rmcup caps. Not the generic xterm ones.
44smcup_str, rmcup_str :: String
45smcup_str = "\ESC7\ESC[?47h"
46rmcup_str = "\ESC[2J\ESC[?47l\ESC8"
48-- iTerm needs a clear screen after smcup as well?
49clear_screen_str :: String
50clear_screen_str = "\ESC[H\ESC[2J"
52instance Terminal Term where
53 terminal_ID t = term_app t ++ " :: MacOSX"
55 release_terminal t = do
56 release_terminal $ super_term t
58 reserve_display _t = do
59 flushed_put smcup_str
60 flushed_put clear_screen_str
62 release_display _t = do
63 flushed_put rmcup_str
65 display_terminal_instance t b c = do
66 d <- display_context (super_term t) b
67 return $ c (DisplayContext d)
69 display_bounds t = display_bounds (super_term t)
71 output_byte_buffer t = output_byte_buffer (super_term t)
73 output_handle t = output_handle (super_term t)
75data DisplayContext = DisplayContext
76 { super_display :: DisplayHandle
77 }
79instance DisplayTerminal DisplayContext where
80 context_region d = context_region (super_display d)
81 context_color_count d = context_color_count (super_display d)
83 move_cursor_required_bytes d = move_cursor_required_bytes (super_display d)
84 serialize_move_cursor d = serialize_move_cursor (super_display d)
86 show_cursor_required_bytes d = show_cursor_required_bytes (super_display d)
87 serialize_show_cursor d = serialize_show_cursor (super_display d)
89 hide_cursor_required_bytes d = hide_cursor_required_bytes (super_display d)
90 serialize_hide_cursor d = serialize_hide_cursor (super_display d)
92 attr_required_bytes d = attr_required_bytes (super_display d)
93 serialize_set_attr d = serialize_set_attr (super_display d)
95 default_attr_required_bytes d = default_attr_required_bytes (super_display d)
96 serialize_default_attr d = serialize_default_attr (super_display d)