{-# LANGUAGE RecordWildCards, NamedFieldPuns, 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 contains "xterm" or "screen", 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, [(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
"xterm" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
termName Bool -> Bool -> Bool
|| String
"screen" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
termName
        then String -> Fd -> IO Output
forall (m :: * -> *).
(Applicative m, MonadIO m) =>
String -> Fd -> m Output
XTermColor.reserveTerminal String
termName Fd
fd
        -- Not an xterm-like terminal. try for generic terminfo.
        else String -> Fd -> IO Output
TerminfoBased.reserveTerminal String
termName Fd
fd

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

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

-- | Sets the cursor position to the given output column and row.
--
-- This is not necessarially 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
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< DisplayRegion -> Int
regionWidth DisplayRegion
bounds Bool -> Bool -> Bool
&& Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< DisplayRegion -> Int
regionHeight DisplayRegion
bounds) (IO () -> IO ()) -> IO () -> IO ()
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 (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Write -> ByteString
writeToByteString (Write -> ByteString) -> Write -> ByteString
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 (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Write -> ByteString
writeToByteString (Write -> ByteString) -> Write -> ByteString
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 (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Write -> ByteString
writeToByteString (Write -> ByteString) -> Write -> ByteString
forall a b. (a -> b) -> a -> b
$ DisplayContext -> Write
writeShowCursor DisplayContext
dc