vty-6.0: src/Graphics/Vty.hs
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- | Vty provides interfaces for both terminal input and terminal
-- output.
--
-- - User input to the terminal is provided to the Vty application as a
-- sequence of 'Event's.
--
-- - Output is provided to by the application to Vty in the form of a
-- 'Picture'. A 'Picture' is one or more layers of 'Image's.
-- 'Image' values can be built by the various constructors in
-- "Graphics.Vty.Image". Output can be syled using 'Attr' (attribute)
-- values in the "Graphics.Vty.Attributes" module.
--
-- - Each platform on which Vty is supported provides a package that
-- provides Vty with access to the platform-specific terminal
-- interface. For example, on Unix systems, the @vty-unix@ package
-- must be used to initialize Vty with access to a Unix terminal.
--
-- As a small example, the following program demonstrates the use of Vty
-- on a Unix system using the @vty-unix@ package:
--
-- > import Graphics.Vty
-- > import Graphics.Vty.Platform.Unix (mkVty)
-- >
-- > main = do
-- > vty <- mkVty defaultConfig
-- > let line0 = string (defAttr `withForeColor` green) "first line"
-- > line1 = string (defAttr `withBackColor` blue) "second line"
-- > img = line0 <-> line1
-- > pic = picForImage img
-- > update vty pic
-- > e <- nextEvent vty
-- > shutdown vty
-- > print ("Last event was: " ++ show e)
--
-- Vty uses threads internally, so programs made with Vty must be
-- compiled with the threaded runtime using the GHC @-threaded@ option.
module Graphics.Vty
( Vty(..)
, setWindowTitle
, installCustomWidthTable
, mkVtyFromPair
, module Graphics.Vty.Config
, module Graphics.Vty.Input
, module Graphics.Vty.Input.Events
, module Graphics.Vty.Output
, module Graphics.Vty.Picture
, module Graphics.Vty.Image
, module Graphics.Vty.Attributes
)
where
import Graphics.Vty.Config
import Graphics.Vty.Input
import Graphics.Vty.Input.Events
import Graphics.Vty.Output
import Graphics.Vty.Picture
import Graphics.Vty.Image
import Graphics.Vty.Attributes
import Graphics.Vty.UnicodeWidthTable.IO
import Graphics.Vty.UnicodeWidthTable.Install
import qualified Control.Exception as E
import Control.Monad (when)
import Control.Concurrent.STM
import Data.IORef
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup ((<>))
#endif
-- | A 'Vty' value represents a handle to the Vty library that the
-- application must create in order to use Vty.
--
-- The use of this library typically follows this process:
--
-- 1. Initialize Vty with the 'mkVty' implementation for your
-- platform's Vty package (e.g. @vty-unix@), or, more generically, with
-- 'mkVtyFromPair'. This takes control of (and sets up) the terminal.
--
-- 2. Use 'update' to display a picture.
--
-- 3. Use 'nextEvent' to get the next input event.
--
-- 4. Depending on the event, go to 2 or 5.
--
-- 5. Shutdown Vty and restore the terminal state with 'shutdown'. At
-- this point the 'Vty' handle cannot be used again.
--
-- Operations on Vty handles are not thread-safe.
data Vty =
Vty { update :: Picture -> IO ()
-- ^ Output the given 'Picture' to the terminal.
, nextEvent :: IO Event
-- ^ Return the next 'Event' or block until one becomes
-- available.
, nextEventNonblocking :: IO (Maybe Event)
-- ^ Non-blocking version of 'nextEvent'.
, inputIface :: Input
-- ^ The input interface. See 'Input'.
, outputIface :: Output
-- ^ The output interface. See 'Output'.
, refresh :: IO ()
-- ^ Refresh the display. If other programs output to the
-- terminal and mess up the display then the application might
-- want to force a refresh using this function.
, shutdown :: IO ()
-- ^ Clean up after vty. A call to this function is necessary to
-- cleanly restore the terminal state before application exit.
-- The above methods will throw an exception if executed after
-- this is executed. Idempotent.
, isShutdown :: IO Bool
}
-- | Attempt to load and install a custom character width table into
-- this process.
--
-- This looks up the specified terminal name in the specified width
-- table map and, if a map file path is found, the map is loaded and
-- installed. This is exposed for Vty platform package implementors;
-- application developers should never need to call this.
installCustomWidthTable :: Maybe FilePath
-- ^ Optional path to a log file where log
-- messages should be written when attempting to
-- load a width table.
-> Maybe String
-- ^ Optional width table entry name (usually
-- the terminal name, e.g. value of @TERM@ on
-- Unix systems). If omitted, this function does
-- not attempt to load a table.
-> [(String, FilePath)]
-- ^ Mapping from width table entry names to
-- width table file paths. This is usually
-- obtained from 'configTermWidthMaps' of
-- 'VtyUserConfig'.
-> IO ()
installCustomWidthTable logPath tblName widthMaps = do
let doLog s = case logPath of
Nothing -> return ()
Just path -> appendFile path $ "installWidthTable: " <> s <> "\n"
customInstalled <- isCustomTableReady
when (not customInstalled) $ do
case tblName of
Nothing ->
doLog "No terminal name given in the configuration, skipping load"
Just name ->
case lookup name widthMaps of
Nothing ->
doLog $ "Width table " <> show name <> " not found in custom character width mapping list"
Just path -> do
tableResult <- E.try $ readUnicodeWidthTable path
case tableResult of
Left (e::E.SomeException) ->
doLog $ "Error reading custom character width table " <>
"at " <> show path <> ": " <> show e
Right (Left msg) ->
doLog $ "Error reading custom character width table " <>
"at " <> show path <> ": " <> msg
Right (Right table) -> do
installResult <- E.try $ installUnicodeWidthTable table
case installResult of
Left (e::E.SomeException) ->
doLog $ "Error installing unicode table (" <>
show path <> ": " <> show e
Right () ->
doLog $ "Successfully installed Unicode width table " <>
" from " <> show path
-- | Build a 'Vty' handle from an input/output pair.
--
-- This is exposed for Vty platform package implementors; application
-- developers should never need to call this, and should instead call
-- @mkVty@ or equivalent from their platform package of choice.
mkVtyFromPair :: Input -> Output -> IO Vty
mkVtyFromPair input out = do
reserveDisplay out
shutdownVar <- newTVarIO False
let shutdownIo = do
alreadyShutdown <- atomically $ swapTVar shutdownVar True
when (not alreadyShutdown) $ do
shutdownInput input
releaseDisplay out
releaseTerminal out
shutdownStatus = readTVarIO shutdownVar
lastPicRef <- newIORef Nothing
lastUpdateRef <- newIORef Nothing
let innerUpdate inPic = do
b <- displayBounds out
mlastUpdate <- readIORef lastUpdateRef
updateData <- case mlastUpdate of
Nothing -> do
dc <- displayContext out b
outputPicture dc inPic
return (b, dc)
Just (lastBounds, lastContext) -> do
if b /= lastBounds
then do
dc <- displayContext out b
outputPicture dc inPic
return (b, dc)
else do
outputPicture lastContext inPic
return (b, lastContext)
writeIORef lastUpdateRef $ Just updateData
writeIORef lastPicRef $ Just inPic
innerRefresh = do
writeIORef lastUpdateRef Nothing
bounds <- displayBounds out
dc <- displayContext out bounds
writeIORef (assumedStateRef $ contextDevice dc) initialAssumedState
mPic <- readIORef lastPicRef
maybe (return ()) innerUpdate mPic
mkResize = uncurry EvResize <$> displayBounds out
translateInternalEvent ResumeAfterInterrupt = mkResize
translateInternalEvent (InputEvent e) = return e
gkey = do
e <- atomically $ readTChan $ eventChannel input
translateInternalEvent e
gkey' = do
mEv <- atomically $ tryReadTChan $ eventChannel input
case mEv of
Just e -> Just <$> translateInternalEvent e
Nothing -> return Nothing
return $ Vty { update = innerUpdate
, nextEvent = gkey
, nextEventNonblocking = gkey'
, inputIface = input
, outputIface = out
, refresh = innerRefresh
, shutdown = shutdownIo
, isShutdown = shutdownStatus
}
-- | Set the terminal window title string.
setWindowTitle :: Vty -> String -> IO ()
setWindowTitle vty title =
setOutputWindowTitle (outputIface vty) title