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 )
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
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 }