on 7448ab8 help sign in
vty/src/Graphics/Vty/Output.hs
106 lines 4.4 kB history raw
1{-# LANGUAGE RecordWildCards #-}
2{-# LANGUAGE NamedFieldPuns #-}
3-- | Output interface.
4--
5-- Access to the current terminal or a specific terminal device.
6--
7-- See also:
8--
9-- 1. "Graphics.Vty.Output": This instantiates an abtract interface to the terminal interface based
10-- on the TERM and COLORTERM environment variables.
11--
12-- 2. "Graphics.Vty.Output.Interface": Defines the generic interface all terminals need to implement.
13--
14-- 3. "Graphics.Vty.Output.TerminfoBased": Defines a terminal instance that uses terminfo for all
15-- control strings. No attempt is made to change the character set to UTF-8 for these terminals.
16-- I don't know a way to reliably determine if that is required or how to do so.
17--
18-- 4. "Graphics.Vty.Output.XTermColor": This module contains an interface suitable for xterm-like
19-- terminals. These are the terminals where TERM == xterm. This does use terminfo for as many
20-- control codes as possible.
21module Graphics.Vty.Output ( module Graphics.Vty.Output
22 , Output(..) -- \todo hide constructors
23 , AssumedState(..)
24 , DisplayContext(..) -- \todo hide constructors
25 , outputPicture
26 , displayContext
27 )
28 where
30import Graphics.Vty.Prelude
32import Graphics.Vty.Config
34import Graphics.Vty.Output.Interface
35import Graphics.Vty.Output.XTermColor as XTermColor
36import Graphics.Vty.Output.TerminfoBased as TerminfoBased
38import Blaze.ByteString.Builder (writeToByteString)
40import Control.Monad.Trans
42import Data.List (isPrefixOf)
43import Data.Monoid ((<>))
45-- | Returns a `Output` for the terminal specified in `Config`
46--
47-- The specific Output implementation used is hidden from the API user. All terminal implementations
48-- are assumed to perform more, or less, the same. Currently, all implementations use terminfo for at
49-- least some terminal specific information.
50--
51-- Specifics about it being based on terminfo are hidden from the API user. If a terminal
52-- implementation is developed for a terminal without terminfo support then Vty should work as
53-- expected on that terminal.
54--
55-- Selection of a terminal is done as follows:
56--
57-- * If TERM contains "xterm" or "screen", use XTermColor.
58-- * otherwise use the TerminfoBased driver.
59--
60-- \todo add an implementation for windows that does not depend on terminfo. Should be installable
61-- with only what is provided in the haskell platform. Use ansi-terminal
62outputForConfig :: Config -> IO Output
63outputForConfig Config{ outputFd = Just fd, termName = Just termName, .. } = do
64 t <- if "xterm" `isPrefixOf` termName || "screen" `isPrefixOf` termName
65 then XTermColor.reserveTerminal termName fd
66 -- Not an xterm-like terminal. try for generic terminfo.
67 else TerminfoBased.reserveTerminal termName fd
69 case mouseMode of
70 Just s -> setMode t Mouse s
71 Nothing -> return ()
73 case bracketedPasteMode of
74 Just s -> setMode t BracketedPaste s
75 Nothing -> return ()
77 return t
78outputForConfig config = (<> config) <$> standardIOConfig >>= outputForConfig
80-- | Sets the cursor position to the given output column and row.
81--
82-- This is not necessarially the same as the character position with the same coordinates.
83-- Characters can be a variable number of columns in width.
84--
85-- Currently, the only way to set the cursor position to a given character coordinate is to specify
86-- the coordinate in the Picture instance provided to outputPicture or refresh.
87setCursorPos :: MonadIO m => Output -> Int -> Int -> m ()
88setCursorPos t x y = do
89 bounds <- displayBounds t
90 when (x >= 0 && x < regionWidth bounds && y >= 0 && y < regionHeight bounds) $ do
91 dc <- displayContext t bounds
92 liftIO $ outputByteBuffer t $ writeToByteString $ writeMoveCursor dc x y
94-- | Hides the cursor
95hideCursor :: MonadIO m => Output -> m ()
96hideCursor t = do
97 bounds <- displayBounds t
98 dc <- displayContext t bounds
99 liftIO $ outputByteBuffer t $ writeToByteString $ writeHideCursor dc
101-- | Shows the cursor
102showCursor :: MonadIO m => Output -> m ()
103showCursor t = do
104 bounds <- displayBounds t
105 dc <- displayContext t bounds
106 liftIO $ outputByteBuffer t $ writeToByteString $ writeShowCursor dc