{-# LANGUAGE RecordWildCards, NamedFieldPuns, CPP #-}
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
outputForConfig :: Config -> IO Output
outputForConfig :: Config -> IO Output
outputForConfig Config{ outputFd :: Config -> Maybe Fd
outputFd = Just fd :: Fd
fd, termName :: Config -> Maybe FilePath
termName = Just termName :: FilePath
termName, .. } = do
Output
t <- if "xterm" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
termName Bool -> Bool -> Bool
|| "screen" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
termName
then FilePath -> Fd -> IO Output
forall (m :: * -> *).
(Applicative m, MonadIO m) =>
FilePath -> Fd -> m Output
XTermColor.reserveTerminal FilePath
termName Fd
fd
else FilePath -> Fd -> IO Output
TerminfoBased.reserveTerminal FilePath
termName Fd
fd
case Maybe Bool
mouseMode of
Just s :: Bool
s -> Output -> Mode -> Bool -> IO ()
setMode Output
t Mode
Mouse Bool
s
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
case Maybe Bool
bracketedPasteMode of
Just s :: Bool
s -> Output -> Mode -> Bool -> IO ()
setMode Output
t Mode
BracketedPaste Bool
s
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 -> 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
setCursorPos :: Output -> Int -> Int -> IO ()
setCursorPos :: Output -> Int -> Int -> IO ()
setCursorPos t :: Output
t x :: Int
x y :: 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
>= 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
>= 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
hideCursor :: Output -> IO ()
hideCursor :: Output -> IO ()
hideCursor t :: 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
showCursor :: Output -> IO ()
showCursor :: Output -> IO ()
showCursor t :: 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