-- | Provides function to initialize the Vty data structure. This is the entry

-- point for Vty applications developed for Windows. In cross-platform

-- development however, users should use the Graphics.Vty.CrossPlatform module

-- instead.

module Graphics.Vty.Platform.Windows
  ( mkVty,
    mkVtyWithSettings
  )
where

import Control.Concurrent.STM
import Control.Monad ( when, unless )

import Graphics.Vty ( Vty(..), installCustomWidthTable, mkVtyFromPair )
import Graphics.Vty.Config ( VtyUserConfig(..) )
import Graphics.Vty.Input ( Input(shutdownInput) )
import Graphics.Vty.Output ( Output(releaseTerminal, releaseDisplay) )
import Graphics.Vty.Platform.Windows.Settings ( defaultSettings, WindowsSettings(settingTermName) )
import Graphics.Vty.Platform.Windows.Input ( buildInput )
import Graphics.Vty.Platform.Windows.Output ( buildOutput )

-- | Given a user configuration, initialize the Vty environment

mkVty :: VtyUserConfig -> IO Vty
mkVty :: VtyUserConfig -> IO Vty
mkVty VtyUserConfig
userConfig = VtyUserConfig -> WindowsSettings -> IO Vty
mkVtyWithSettings VtyUserConfig
userConfig (WindowsSettings -> IO Vty) -> IO WindowsSettings -> IO Vty
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO WindowsSettings
defaultSettings

-- | 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.

mkVtyWithSettings :: VtyUserConfig -> WindowsSettings -> IO Vty
mkVtyWithSettings :: VtyUserConfig -> WindowsSettings -> IO Vty
mkVtyWithSettings VtyUserConfig
userConfig WindowsSettings
settings = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (VtyUserConfig -> Maybe Bool
configAllowCustomUnicodeWidthTables VtyUserConfig
userConfig Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Maybe FilePath -> Maybe FilePath -> [(FilePath, FilePath)] -> IO ()
installCustomWidthTable (VtyUserConfig -> Maybe FilePath
configDebugLog VtyUserConfig
userConfig)
                                (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ WindowsSettings -> FilePath
settingTermName WindowsSettings
settings)
                                (VtyUserConfig -> [(FilePath, FilePath)]
configTermWidthMaps VtyUserConfig
userConfig)

    Input
input <- VtyUserConfig -> WindowsSettings -> IO Input
buildInput VtyUserConfig
userConfig WindowsSettings
settings
    Output
out <- VtyUserConfig -> WindowsSettings -> IO Output
buildOutput VtyUserConfig
userConfig WindowsSettings
settings
    Vty
vty <- Input -> Output -> IO Vty
mkVtyFromPair Input
input Output
out

    TVar Bool
shutdownVar <- Bool -> IO (TVar Bool)
forall a. a -> IO (TVar a)
newTVarIO 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 ()
unless Bool
alreadyShutdown (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                Output -> IO ()
releaseDisplay Output
out
                Output -> IO ()
releaseTerminal Output
out
                Input -> IO ()
shutdownInput Input
input

        shutdownStatus :: IO Bool
shutdownStatus = TVar Bool -> IO Bool
forall a. TVar a -> IO a
readTVarIO TVar Bool
shutdownVar

    Vty -> IO Vty
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vty -> IO Vty) -> Vty -> IO Vty
forall a b. (a -> b) -> a -> b
$ Vty
vty { shutdown :: IO ()
shutdown = IO ()
shutdownIo
                 , isShutdown :: IO Bool
isShutdown = IO Bool
shutdownStatus }