{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Graphics.Vty.Platform.Unix.Output.Color
( detectColorMode
)
where
import System.Environment (lookupEnv)
import qualified System.Console.Terminfo as Terminfo
import Control.Exception (catch)
import Data.Maybe
import Graphics.Vty.Attributes.Color
detectColorMode :: String -> IO ColorMode
detectColorMode :: String -> IO ColorMode
detectColorMode String
termName' = do
term <- IO (Maybe Terminal)
-> (SetupTermError -> IO (Maybe Terminal)) -> IO (Maybe Terminal)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (Terminal -> Maybe Terminal
forall a. a -> Maybe a
Just (Terminal -> Maybe Terminal) -> IO Terminal -> IO (Maybe Terminal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Terminal
Terminfo.setupTerm String
termName')
(\(SetupTermError
_ :: Terminfo.SetupTermError) -> Maybe Terminal -> IO (Maybe Terminal)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Terminal
forall a. Maybe a
Nothing)
let getCap Capability b
cap = Maybe Terminal
term Maybe Terminal -> (Terminal -> Maybe b) -> Maybe b
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Terminal
t -> Terminal -> Capability b -> Maybe b
forall a. Terminal -> Capability a -> Maybe a
Terminfo.getCapability Terminal
t Capability b
cap
termColors = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Capability Int -> Maybe Int
forall {b}. Capability b -> Maybe b
getCap (String -> Capability Int
Terminfo.tiGetNum String
"colors")
colorterm <- lookupEnv "COLORTERM"
return $ if
| termColors < 8 -> NoColor
| termColors < 16 -> ColorMode8
| termColors == 16 -> ColorMode16
| termColors < 256 -> ColorMode240 (fromIntegral termColors - 16)
| colorterm == Just "truecolor" -> FullColor
| colorterm == Just "24bit" -> FullColor
| otherwise -> ColorMode240 240