{-# LANGUAGE RecordWildCards, CPP #-}
-- | This module provides functions for accessing the current terminal
-- or a specific terminal device.
--
-- See also:
--
-- 1. "Graphics.Vty.Output": This instantiates an abtract interface
-- to the terminal based on the @TERM@ and @COLORTERM@ environment
-- variables.
--
-- 2. "Graphics.Vty.Output.Interface": Defines the generic interface all
-- terminal modules need to implement.
--
-- 3. "Graphics.Vty.Output.TerminfoBased": Defines a terminal instance
-- that uses terminfo for all control strings. No attempt is made to
-- change the character set to UTF-8 for these terminals.
--
-- 4. "Graphics.Vty.Output.XTermColor": This module contains an
-- interface suitable for xterm-like terminals. These are the terminals
-- where @TERM@ begins with @xterm@. This does use terminfo for as many
-- control codes as possible.
module Graphics.Vty.Output
  ( outputForConfig
  , setCursorPos
  , hideCursor
  , showCursor
  )
where

import Control.Monad (when)

import Graphics.Vty.Config
import Graphics.Vty.Image (regionWidth, regionHeight)
import Graphics.Vty.Output.Interface
import Graphics.Vty.Output.XTermColor as XTermColor
import Graphics.Vty.Output.TerminfoBased as TerminfoBased

import Blaze.ByteString.Builder (writeToByteString)

import Data.List (isPrefixOf)

#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif

-- | Returns an `Output` for the terminal specified in `Config`.
--
-- The specific Output implementation used is hidden from the API user.
-- All terminal implementations are assumed to perform more, or less,
-- the same. Currently, all implementations use terminfo for at least
-- some terminal specific information.
--
-- If a terminal implementation is developed for a terminal without
-- terminfo support then Vty should work as expected on that terminal.
--
-- Selection of a terminal is done as follows:
--
--      * If TERM starts with "xterm", "screen" or "tmux", use XTermColor.
--      * otherwise use the TerminfoBased driver.
outputForConfig :: Config -> IO Output
outputForConfig :: Config -> IO Output
outputForConfig Config{ outputFd :: Config -> Maybe Fd
outputFd = Just Fd
fd, termName :: Config -> Maybe String
termName = Just String
termName
                      , colorMode :: Config -> Maybe ColorMode
colorMode = Just ColorMode
colorMode, [(String, String)]
InputMap
Maybe Bool
Maybe Int
Maybe String
Maybe Fd
allowCustomUnicodeWidthTables :: Config -> Maybe Bool
termWidthMaps :: Config -> [(String, String)]
inputFd :: Config -> Maybe Fd
inputMap :: Config -> InputMap
debugLog :: Config -> Maybe String
bracketedPasteMode :: Config -> Maybe Bool
mouseMode :: Config -> Maybe Bool
vtime :: Config -> Maybe Int
vmin :: Config -> Maybe Int
allowCustomUnicodeWidthTables :: Maybe Bool
termWidthMaps :: [(String, String)]
inputFd :: Maybe Fd
inputMap :: InputMap
debugLog :: Maybe String
bracketedPasteMode :: Maybe Bool
mouseMode :: Maybe Bool
vtime :: Maybe Int
vmin :: Maybe Int
.. } = do
    Output
t <- if String -> Bool
isXtermLike String
termName
         then forall (m :: * -> *).
(Applicative m, MonadIO m) =>
String -> Fd -> ColorMode -> m Output
XTermColor.reserveTerminal String
termName Fd
fd ColorMode
colorMode
         -- Not an xterm-like terminal. try for generic terminfo.
         else String -> Fd -> ColorMode -> IO Output
TerminfoBased.reserveTerminal String
termName Fd
fd ColorMode
colorMode

    case Maybe Bool
mouseMode of
        Just Bool
s -> Output -> Mode -> Bool -> IO ()
setMode Output
t Mode
Mouse Bool
s
        Maybe Bool
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

    case Maybe Bool
bracketedPasteMode of
        Just Bool
s -> Output -> Mode -> Bool -> IO ()
setMode Output
t Mode
BracketedPaste Bool
s
        Maybe Bool
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

    forall (m :: * -> *) a. Monad m => a -> m a
return Output
t
outputForConfig Config
config = (forall a. Semigroup a => a -> a -> a
<> Config
config) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Config
standardIOConfig forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Config -> IO Output
outputForConfig

isXtermLike :: String -> Bool
isXtermLike :: String -> Bool
isXtermLike String
termName =
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
termName) [String]
xtermLikeTerminalNamePrefixes

xtermLikeTerminalNamePrefixes :: [String]
xtermLikeTerminalNamePrefixes :: [String]
xtermLikeTerminalNamePrefixes =
    [ String
"xterm"
    , String
"screen"
    , String
"tmux"
    , String
"rxvt"
    ]

-- | Sets the cursor position to the given output column and row.
--
-- This is not necessarily the same as the character position with the
-- same coordinates. Characters can be a variable number of columns in
-- width.
--
-- Currently, the only way to set the cursor position to a given
-- character coordinate is to specify the coordinate in the Picture
-- instance provided to 'outputPicture' or 'refresh'.
setCursorPos :: Output -> Int -> Int -> IO ()
setCursorPos :: Output -> Int -> Int -> IO ()
setCursorPos Output
t Int
x Int
y = do
    DisplayRegion
bounds <- Output -> IO DisplayRegion
displayBounds Output
t
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
x forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
x forall a. Ord a => a -> a -> Bool
< DisplayRegion -> Int
regionWidth DisplayRegion
bounds Bool -> Bool -> Bool
&& Int
y forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
y forall a. Ord a => a -> a -> Bool
< DisplayRegion -> Int
regionHeight DisplayRegion
bounds) forall a b. (a -> b) -> a -> b
$ do
        DisplayContext
dc <- Output -> DisplayRegion -> IO DisplayContext
displayContext Output
t DisplayRegion
bounds
        Output -> ByteString -> IO ()
outputByteBuffer Output
t forall a b. (a -> b) -> a -> b
$ Write -> ByteString
writeToByteString forall a b. (a -> b) -> a -> b
$ DisplayContext -> Int -> Int -> Write
writeMoveCursor DisplayContext
dc Int
x Int
y

-- | Hides the cursor.
hideCursor :: Output -> IO ()
hideCursor :: Output -> IO ()
hideCursor Output
t = do
    DisplayRegion
bounds <- Output -> IO DisplayRegion
displayBounds Output
t
    DisplayContext
dc <- Output -> DisplayRegion -> IO DisplayContext
displayContext Output
t DisplayRegion
bounds
    Output -> ByteString -> IO ()
outputByteBuffer Output
t forall a b. (a -> b) -> a -> b
$ Write -> ByteString
writeToByteString forall a b. (a -> b) -> a -> b
$ DisplayContext -> Write
writeHideCursor DisplayContext
dc

-- | Shows the cursor.
showCursor :: Output -> IO ()
showCursor :: Output -> IO ()
showCursor Output
t = do
    DisplayRegion
bounds <- Output -> IO DisplayRegion
displayBounds Output
t
    DisplayContext
dc <- Output -> DisplayRegion -> IO DisplayContext
displayContext Output
t DisplayRegion
bounds
    Output -> ByteString -> IO ()
outputByteBuffer Output
t forall a b. (a -> b) -> a -> b
$ Write -> ByteString
writeToByteString forall a b. (a -> b) -> a -> b
$ DisplayContext -> Write
writeShowCursor DisplayContext
dc