{-# LANGUAGE CPP #-}

-- | Vty provides interfaces for both terminal input and terminal
-- output.
--
-- - Input to the terminal is provided to the Vty application as a
--   sequence of 'Event's.
--
-- - Output is provided to Vty by the application 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.
--
-- Vty uses threads internally, so programs made with Vty need to be
-- compiled with the threaded runtime using the GHC `-threaded` option.
--
-- @
--  import "Graphics.Vty"
--
--  main = do
--      cfg <- 'standardIOConfig'
--      vty <- 'mkVty' cfg
--      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)
-- @
module Graphics.Vty
  ( Vty(..)
  , mkVty
  , Mode(..)
  , module Graphics.Vty.Config
  , module Graphics.Vty.Input
  , module Graphics.Vty.Output
  , module Graphics.Vty.Output.Interface
  , module Graphics.Vty.Picture
  , module Graphics.Vty.Image
  , module Graphics.Vty.Attributes
  )
where

import Graphics.Vty.Config
import Graphics.Vty.Input
import Graphics.Vty.Output
import Graphics.Vty.Output.Interface
import Graphics.Vty.Picture
import Graphics.Vty.Image
import Graphics.Vty.Attributes

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 Vty typically follows this process:
--
--    1. Initialize vty
--
--    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.
--
-- Operations on Vty handles are not thread-safe.
data Vty = Vty
    { -- | Outputs the given 'Picture'.
      Vty -> Picture -> IO ()
update :: Picture -> IO ()
      -- | Return the next 'Event' or block until one becomes available.
    , Vty -> IO Event
nextEvent :: IO Event
      -- | Non-blocking version of 'nextEvent'.
    , Vty -> IO (Maybe Event)
nextEventNonblocking :: IO (Maybe Event)
      -- | The input interface. See 'Input'.
    , Vty -> Input
inputIface :: Input
      -- | The output interface. See 'Output'.
    , Vty -> Output
outputIface :: Output
      -- | 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.
    , Vty -> IO ()
refresh :: 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.
    , Vty -> IO ()
shutdown :: IO ()
    , Vty -> IO Bool
isShutdown :: IO Bool
    }

-- | Create a Vty handle. At most one handle should be created at a time
-- for a given terminal device.
--
-- The specified configuration is added to the the configuration
-- loaded by 'userConfig' with the 'userConfig' configuration taking
-- precedence. See "Graphics.Vty.Config".
--
-- For most applications @mkVty defaultConfig@ is sufficient.
mkVty :: Config -> IO Vty
mkVty :: Config -> IO Vty
mkVty appConfig :: Config
appConfig = do
    Config
config <- (Config -> Config -> Config
forall a. Semigroup a => a -> a -> a
<> Config
appConfig) (Config -> Config) -> IO Config -> IO Config
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Config
userConfig
    Input
input  <- Config -> IO Input
inputForConfig Config
config
    Output
out    <- Config -> IO Output
outputForConfig Config
config
    Input -> Output -> IO Vty
intMkVty Input
input Output
out

intMkVty :: Input -> Output -> IO Vty
intMkVty :: Input -> Output -> IO Vty
intMkVty input :: Input
input out :: Output
out = do
    Output -> IO ()
reserveDisplay Output
out

    TVar Bool
shutdownVar <- STM (TVar Bool) -> IO (TVar Bool)
forall a. STM a -> IO a
atomically (STM (TVar Bool) -> IO (TVar Bool))
-> STM (TVar Bool) -> IO (TVar Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> STM (TVar Bool)
forall a. a -> STM (TVar a)
newTVar Bool
False
    let shutdownIo :: IO ()
shutdownIo = do
            Bool
alreadyShutdown <- STM Bool -> IO Bool
forall a. STM a -> IO a
atomically (STM Bool -> IO Bool) -> STM Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ TVar Bool -> Bool -> STM Bool
forall a. TVar a -> a -> STM a
swapTVar TVar Bool
shutdownVar Bool
True
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
alreadyShutdown) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                Input -> IO ()
shutdownInput Input
input
                Output -> IO ()
releaseDisplay Output
out
                Output -> IO ()
releaseTerminal Output
out

    let shutdownStatus :: IO Bool
shutdownStatus = STM Bool -> IO Bool
forall a. STM a -> IO a
atomically (STM Bool -> IO Bool) -> STM Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ TVar Bool -> STM Bool
forall a. TVar a -> STM a
readTVar TVar Bool
shutdownVar

    IORef (Maybe Picture)
lastPicRef <- Maybe Picture -> IO (IORef (Maybe Picture))
forall a. a -> IO (IORef a)
newIORef Maybe Picture
forall a. Maybe a
Nothing
    IORef (Maybe (DisplayRegion, DisplayContext))
lastUpdateRef <- Maybe (DisplayRegion, DisplayContext)
-> IO (IORef (Maybe (DisplayRegion, DisplayContext)))
forall a. a -> IO (IORef a)
newIORef Maybe (DisplayRegion, DisplayContext)
forall a. Maybe a
Nothing

    let innerUpdate :: Picture -> IO ()
innerUpdate inPic :: Picture
inPic = do
            DisplayRegion
b <- Output -> IO DisplayRegion
displayBounds Output
out
            Maybe (DisplayRegion, DisplayContext)
mlastUpdate <- IORef (Maybe (DisplayRegion, DisplayContext))
-> IO (Maybe (DisplayRegion, DisplayContext))
forall a. IORef a -> IO a
readIORef IORef (Maybe (DisplayRegion, DisplayContext))
lastUpdateRef
            (DisplayRegion, DisplayContext)
updateData <- case Maybe (DisplayRegion, DisplayContext)
mlastUpdate of
                Nothing -> do
                    DisplayContext
dc <- Output -> DisplayRegion -> IO DisplayContext
displayContext Output
out DisplayRegion
b
                    DisplayContext -> Picture -> IO ()
outputPicture DisplayContext
dc Picture
inPic
                    (DisplayRegion, DisplayContext)
-> IO (DisplayRegion, DisplayContext)
forall (m :: * -> *) a. Monad m => a -> m a
return (DisplayRegion
b, DisplayContext
dc)
                Just (lastBounds, lastContext) -> do
                    if DisplayRegion
b DisplayRegion -> DisplayRegion -> Bool
forall a. Eq a => a -> a -> Bool
/= DisplayRegion
lastBounds
                        then do
                            DisplayContext
dc <- Output -> DisplayRegion -> IO DisplayContext
displayContext Output
out DisplayRegion
b
                            DisplayContext -> Picture -> IO ()
outputPicture DisplayContext
dc Picture
inPic
                            (DisplayRegion, DisplayContext)
-> IO (DisplayRegion, DisplayContext)
forall (m :: * -> *) a. Monad m => a -> m a
return (DisplayRegion
b, DisplayContext
dc)
                        else do
                            DisplayContext -> Picture -> IO ()
outputPicture DisplayContext
lastContext Picture
inPic
                            (DisplayRegion, DisplayContext)
-> IO (DisplayRegion, DisplayContext)
forall (m :: * -> *) a. Monad m => a -> m a
return (DisplayRegion
b, DisplayContext
lastContext)
            IORef (Maybe (DisplayRegion, DisplayContext))
-> Maybe (DisplayRegion, DisplayContext) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (DisplayRegion, DisplayContext))
lastUpdateRef (Maybe (DisplayRegion, DisplayContext) -> IO ())
-> Maybe (DisplayRegion, DisplayContext) -> IO ()
forall a b. (a -> b) -> a -> b
$ (DisplayRegion, DisplayContext)
-> Maybe (DisplayRegion, DisplayContext)
forall a. a -> Maybe a
Just (DisplayRegion, DisplayContext)
updateData
            IORef (Maybe Picture) -> Maybe Picture -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe Picture)
lastPicRef (Maybe Picture -> IO ()) -> Maybe Picture -> IO ()
forall a b. (a -> b) -> a -> b
$ Picture -> Maybe Picture
forall a. a -> Maybe a
Just Picture
inPic

    let innerRefresh :: IO ()
innerRefresh = do
            IORef (Maybe (DisplayRegion, DisplayContext))
-> Maybe (DisplayRegion, DisplayContext) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (DisplayRegion, DisplayContext))
lastUpdateRef Maybe (DisplayRegion, DisplayContext)
forall a. Maybe a
Nothing
            DisplayRegion
bounds <- Output -> IO DisplayRegion
displayBounds Output
out
            DisplayContext
dc <- Output -> DisplayRegion -> IO DisplayContext
displayContext Output
out DisplayRegion
bounds
            IORef AssumedState -> AssumedState -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Output -> IORef AssumedState
assumedStateRef (Output -> IORef AssumedState) -> Output -> IORef AssumedState
forall a b. (a -> b) -> a -> b
$ DisplayContext -> Output
contextDevice DisplayContext
dc) AssumedState
initialAssumedState
            Maybe Picture
mPic <- IORef (Maybe Picture) -> IO (Maybe Picture)
forall a. IORef a -> IO a
readIORef IORef (Maybe Picture)
lastPicRef
            IO () -> (Picture -> IO ()) -> Maybe Picture -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Picture -> IO ()
innerUpdate Maybe Picture
mPic

    let mkResize :: IO Event
mkResize = (Int -> Int -> Event) -> DisplayRegion -> Event
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> Event
EvResize (DisplayRegion -> Event) -> IO DisplayRegion -> IO Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Output -> IO DisplayRegion
displayBounds Output
out
        gkey :: IO Event
gkey = do
            Event
k <- STM Event -> IO Event
forall a. STM a -> IO a
atomically (STM Event -> IO Event) -> STM Event -> IO Event
forall a b. (a -> b) -> a -> b
$ TChan Event -> STM Event
forall a. TChan a -> STM a
readTChan (TChan Event -> STM Event) -> TChan Event -> STM Event
forall a b. (a -> b) -> a -> b
$ Input -> TChan Event
_eventChannel Input
input
            case Event
k of
                (EvResize _ _)  -> IO Event
mkResize
                _ -> Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return Event
k
        gkey' :: IO (Maybe Event)
gkey' = do
            Maybe Event
k <- STM (Maybe Event) -> IO (Maybe Event)
forall a. STM a -> IO a
atomically (STM (Maybe Event) -> IO (Maybe Event))
-> STM (Maybe Event) -> IO (Maybe Event)
forall a b. (a -> b) -> a -> b
$ TChan Event -> STM (Maybe Event)
forall a. TChan a -> STM (Maybe a)
tryReadTChan (TChan Event -> STM (Maybe Event))
-> TChan Event -> STM (Maybe Event)
forall a b. (a -> b) -> a -> b
$ Input -> TChan Event
_eventChannel Input
input
            case Maybe Event
k of
                (Just (EvResize _ _))  -> Event -> Maybe Event
forall a. a -> Maybe a
Just (Event -> Maybe Event) -> IO Event -> IO (Maybe Event)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Event
mkResize
                _ -> Maybe Event -> IO (Maybe Event)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Event
k

    Vty -> IO Vty
forall (m :: * -> *) a. Monad m => a -> m a
return (Vty -> IO Vty) -> Vty -> IO Vty
forall a b. (a -> b) -> a -> b
$ Vty :: (Picture -> IO ())
-> IO Event
-> IO (Maybe Event)
-> Input
-> Output
-> IO ()
-> IO ()
-> IO Bool
-> Vty
Vty { update :: Picture -> IO ()
update = Picture -> IO ()
innerUpdate
                 , nextEvent :: IO Event
nextEvent = IO Event
gkey
                 , nextEventNonblocking :: IO (Maybe Event)
nextEventNonblocking = IO (Maybe Event)
gkey'
                 , inputIface :: Input
inputIface = Input
input
                 , outputIface :: Output
outputIface = Output
out
                 , refresh :: IO ()
refresh = IO ()
innerRefresh
                 , shutdown :: IO ()
shutdown = IO ()
shutdownIo
                 , isShutdown :: IO Bool
isShutdown = IO Bool
shutdownStatus
                 }