@@ -49,7 +49,7 @@ where
4949import Data.Word
5050import GHC.Generics
5151import Control.DeepSeq
52−import Text.Printf (printf)
52+import System.Environment (lookupEnv)
5353
5454import qualified System.Console.Terminfo as Terminfo
5555import Control.Exception (catch)
@@ -95,7 +95,7 @@ import Graphics.Vty.Attributes.Color240
9595-- reported then the color reproduction will be incorrect.
9696--
9797-- If the terminal reports <= 16 colors then the 240 color palette
98−-- points are only mapped to the 8 color pallete. I'm not sure of
98+-- points are only mapped to the 8 color palette. I'm not sure of
9999-- the RGB points for the "bright" colors which is why they are not
100100-- addressable via the 240 color palette.
101101--
@@ -126,12 +126,15 @@ detectColorMode termName' = do
126126 (\(_ :: Terminfo.SetupTermError) -> return Nothing)
127127 let getCap cap = term >>= \t -> Terminfo.getCapability t cap
128128 termColors = fromMaybe 0 $ getCap (Terminfo.tiGetNum "colors")
129+ colorterm <- lookupEnv "COLORTERM"
129130 return $ if
130− | termColors < 8 -> NoColor
131− | termColors < 16 -> ColorMode8
132− | termColors == 16 -> ColorMode16
133− | termColors < 256 -> ColorMode240 (fromIntegral termColors - 16)
134− | otherwise -> ColorMode240 240
131+ | termColors < 8 -> NoColor
132+ | termColors < 16 -> ColorMode8
133+ | termColors == 16 -> ColorMode16
134+ | termColors < 256 -> ColorMode240 (fromIntegral termColors - 16)
135+ | colorterm == Just "truecolor" -> FullColor
136+ | colorterm == Just "24bit" -> FullColor
137+ | otherwise -> ColorMode240 240
135138
136139black, red, green, yellow, blue, magenta, cyan, white :: Color
137140black = ISOColor 0
@@ -154,18 +157,13 @@ brightMagenta= ISOColor 13
154157brightCyan = ISOColor 14
155158brightWhite = ISOColor 15
156159
157−-- TODO: test this with other terminals
158160linearColor :: Integral i => i -> i -> i -> Color
159−linearColor r g b
160− | r < 0 || r > 255 = makeError
161− | g < 0 || g > 255 = makeError
162− | b < 0 || b > 255 = makeError
163− | otherwise = RGBColor r' g' b'
161+linearColor r g b = RGBColor r' g' b'
164162 where
165− r' = fromIntegral r :: Word8
166− g' = fromIntegral g :: Word8
167− b' = fromIntegral b :: Word8
168− makeError = error $ printf "invalid value in rgbColor: (%d, %d, %d)" r' g' b'
163+ r' = fromIntegral (clamp r) :: Word8
164+ g' = fromIntegral (clamp g) :: Word8
165+ b' = fromIntegral (clamp b) :: Word8
166+ clamp = min 255 . max 0
169167
170168srgbColor :: Integral i => i -> i -> i -> Color
171169srgbColor r g b =