master..a9e45da · vty · git.iko.soy

git.iko.soy/vty

on a9e45da help sign in

CHANGELOG.md−38

since splitsnapshots

unifiedsplit

@@ -1,42 +1,4 @@

2−5.35.1

3−------

4−

5−Bug fixes:

6− * Fixed a build issue with a test program.

7−

8−5.35

9−----

10−

11−New features:

12− * Add support for 24-bit color (thanks @u-quark). This change

13− updates Vty to look at the `COLORTERM` environment variable that is

14− conventionally used to advertise support for truecolor escape

15− sequences. The change also updates the Vty demo to demonstrate

16− 24-bit colors. This change also adds a new data type, `ColorMode`,

17− to represent the color mode in use, as well as an `Output` interface

18− field, `outputColorMode`, to track the active color mode and use it

19− to clamp emitted color escape sequences to the active color range.

20−

21−API changes:

22− * All types in `Graphics.Vty.Input.Events` now have strict constructor

23− fields.

24− * Internal events are now wrapped in a new `InternalEvent` type to

25− improve how signal handling is done. This change modifies the `Input`

26− type's event channel API to produce `InternalEvents`, not `Events`.

27− The new `InternalEvent` either wraps `Event` with the `InputEvent`

28− constructor (the previous behavior) or indicates that Vty resumed

29− after handling a signal using the `ResumeAfterSignal` constructor.

30− This change avoids the previous use of `EvResize` with lazy exception

31− arguments as a sentinel value for `ResumeAfterSignal`.

32−

33−Other enhancements:

34− * Bracketed paste parsing performance has been greatly improved thanks

35− to benchmarking and optimization work by @iphydf. As part of that

36− work, Vty now uses bytestrings rather than Strings internally when

37− parsing input to look for events.

38− * The `\b` value is now interpreted as `KBS` (thanks @vglfr)

39−

405.34

25.34

41----

3----

demos/Demo.hs+4−12

@@ -31,8 +31,7 @@ introText = vertCat $ map (string defAttr)

31 [ "this line is hidden by the top layer"

32 , "The vty demo program will echo the events generated by the pressed keys."

33 , "Below there is a 240 color box."

34− , "Followed by a description of the 16 color palette."

34+ , "Followed by a description of the 16 color pallete."

35− , "Followed by tones of red using a 24-bit palette."

36 , "If the 240 color box is not visible then the terminal"

35 , "If the 240 color box is not visible then the terminal"

37 , "claims 240 colors are not supported."

36 , "claims 240 colors are not supported."

38 , "Try setting TERM to xterm-256color"

37 , "Try setting TERM to xterm-256color"

@@ -43,19 +42,12 @@ introText = vertCat $ map (string defAttr)

43 , "¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯"

42 , "¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯"

44 ]

43 ]

46−splitColorImages :: [Image] -> [[Image]]

47−splitColorImages [] = []

48−splitColorImages is = (take 20 is ++ [string defAttr " "]) : (splitColorImages (drop 20 is))

49−

50−fullcolorbox :: Image

51−fullcolorbox = vertCat $ map horizCat $ splitColorImages colorImages

52− where

53− colorImages = map (\i -> string (currentAttr `withBackColor` linearColor i 0 0) " ") [0..255]

54−

55colorbox_240 :: Image

45colorbox_240 :: Image

56colorbox_240 = vertCat $ map horizCat $ splitColorImages colorImages

46colorbox_240 = vertCat $ map horizCat $ splitColorImages colorImages

57 where

47 where

58 colorImages = map (\i -> string (currentAttr `withBackColor` Color240 i) " ") [0..239]

48 colorImages = map (\i -> string (currentAttr `withBackColor` Color240 i) " ") [0..239]

49+ splitColorImages [] = []

50+ splitColorImages is = (take 20 is ++ [string defAttr " "]) : (splitColorImages (drop 20 is))

60colorbox_16 :: Image

52colorbox_16 :: Image

@@ -78,7 +70,7 @@ updateDisplay = do

78 "Press ESC to exit. Events for keys below."

70 "Press ESC to exit. Events for keys below."

79 eventLog <- foldMap (string defAttr) <$> get

71 eventLog <- foldMap (string defAttr) <$> get

80 let pic = picForImage (info <-> eventLog)

72 let pic = picForImage (info <-> eventLog)

81− `addToBottom` (introText <-> colorbox_240 <|> colorbox_16 <|> fullcolorbox)

73+ `addToBottom` (introText <-> colorbox_240 <|> colorbox_16)

82 vty <- ask

74 vty <- ask

83 liftIO $ update vty pic

75 liftIO $ update vty pic

src/Graphics/Vty/Attributes/Color.hs+3−67

@@ -1,14 +1,8 @@

1{-# LANGUAGE DeriveGeneric #-}

2{-# LANGUAGE DeriveAnyClass #-}

3−{-# LANGUAGE MultiWayIf #-}

4−{-# LANGUAGE ScopedTypeVariables #-}

6module Graphics.Vty.Attributes.Color

4module Graphics.Vty.Attributes.Color

7 ( Color(..)

5 ( Color(..)

8− , ColorMode(..)

9−

10− -- * Detecting Terminal Color Support

11− , detectColorMode

13 -- ** Fixed Colors

7 -- ** Fixed Colors

14 -- | Standard 8-color ANSI terminal color codes.

8 -- | Standard 8-color ANSI terminal color codes.

@@ -38,10 +32,7 @@ module Graphics.Vty.Attributes.Color

38 , brightCyan

32 , brightCyan

39 , brightWhite

33 , brightWhite

40 -- ** Creating Colors From RGB

34 -- ** Creating Colors From RGB

41− , linearColor

42− , srgbColor

43 , rgbColor

35 , rgbColor

44− , color240

45 , module Graphics.Vty.Attributes.Color240

36 , module Graphics.Vty.Attributes.Color240

46 )

37 )

47where

38where

@@ -49,11 +40,6 @@ where

49import Data.Word

40import Data.Word

50import GHC.Generics

41import GHC.Generics

51import Control.DeepSeq

42import Control.DeepSeq

52−import System.Environment (lookupEnv)

53−

54−import qualified System.Console.Terminfo as Terminfo

55−import Control.Exception (catch)

56−import Data.Maybe

58import Graphics.Vty.Attributes.Color240

44import Graphics.Vty.Attributes.Color240

@@ -95,7 +81,7 @@ import Graphics.Vty.Attributes.Color240

95-- reported then the color reproduction will be incorrect.

81-- reported then the color reproduction will be incorrect.

96--

82--

97-- If the terminal reports <= 16 colors then the 240 color palette

83-- If the terminal reports <= 16 colors then the 240 color palette

98−-- points are only mapped to the 8 color palette. I'm not sure of

84+-- points are only mapped to the 8 color pallete. I'm not sure of

99-- the RGB points for the "bright" colors which is why they are not

85-- the RGB points for the "bright" colors which is why they are not

100-- addressable via the 240 color palette.

86-- addressable via the 240 color palette.

101--

87--

@@ -109,33 +95,9 @@ import Graphics.Vty.Attributes.Color240

109-- terminfo but I don't know it.

95-- terminfo but I don't know it.

110--

96--

111-- Seriously, terminal color support is INSANE.

97-- Seriously, terminal color support is INSANE.

112−data Color = ISOColor !Word8 | Color240 !Word8 | RGBColor !Word8 !Word8 !Word8

98+data Color = ISOColor !Word8 | Color240 !Word8

113 deriving ( Eq, Show, Read, Generic, NFData )

99 deriving ( Eq, Show, Read, Generic, NFData )

114

100

115−data ColorMode

116− = NoColor

117− | ColorMode8

118− | ColorMode16

119− | ColorMode240 !Word8

120− | FullColor

121− deriving ( Eq, Show )

122−

123−detectColorMode :: String -> IO ColorMode

124−detectColorMode termName' = do

125− term <- catch (Just <$> Terminfo.setupTerm termName')

126− (\(_ :: Terminfo.SetupTermError) -> return Nothing)

127− let getCap cap = term >>= \t -> Terminfo.getCapability t cap

128− termColors = fromMaybe 0 $ getCap (Terminfo.tiGetNum "colors")

129− colorterm <- lookupEnv "COLORTERM"

130− return $ if

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

138−

139black, red, green, yellow, blue, magenta, cyan, white :: Color

101black, red, green, yellow, blue, magenta, cyan, white :: Color

140black = ISOColor 0

102black = ISOColor 0

141red = ISOColor 1

103red = ISOColor 1

@@ -157,35 +119,9 @@ brightMagenta= ISOColor 13

157brightCyan = ISOColor 14

119brightCyan = ISOColor 14

158brightWhite = ISOColor 15

120brightWhite = ISOColor 15

159

121

160−linearColor :: Integral i => i -> i -> i -> Color

161−linearColor r g b = RGBColor r' g' b'

162− where

163− r' = fromIntegral (clamp r) :: Word8

164− g' = fromIntegral (clamp g) :: Word8

165− b' = fromIntegral (clamp b) :: Word8

166− clamp = min 255 . max 0

167−

168−srgbColor :: Integral i => i -> i -> i -> Color

169−srgbColor r g b =

170− -- srgb to rgb transformation as described at

171− -- https://en.wikipedia.org/wiki/SRGB#The_reverse_transformation

172− --

173− -- TODO: it may be worth translating this to a lookup table, as with color240

174− let shrink n = fromIntegral n / 255 :: Double

175− -- called gamma^-1 in wiki

176− gamma u

177− | u <= 0.04045 = u/12.92

178− | otherwise = ((u + 0.055) / 1.055) ** 2.4

179− -- TODO: this is a slightly inaccurate conversion. is it worth doing proterly?

180− expand n = round (255 * n)

181− convert = expand . gamma . shrink

182− in RGBColor (convert r) (convert g) (convert b)

183−

184−color240 :: Integral i => i -> i -> i -> Color

185−color240 r g b = Color240 (rgbColorToColor240 r g b)

186

122

187-- | Create a Vty 'Color' (in the 240 color set) from an RGB triple.

123-- | Create a Vty 'Color' (in the 240 color set) from an RGB triple.

188-- This function is lossy in the sense that we only internally support 240 colors but the

124-- This function is lossy in the sense that we only internally support 240 colors but the

189-- #RRGGBB format supports 16^3 colors.

125-- #RRGGBB format supports 16^3 colors.

190rgbColor :: Integral i => i -> i -> i -> Color

126rgbColor :: Integral i => i -> i -> i -> Color

191−rgbColor = color240

127+rgbColor r g b = Color240 (rgbColorToColor240 r g b)

src/Graphics/Vty/Config.hs+1−10

@@ -3,7 +3,6 @@

3{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}

4{-# LANGUAGE TypeOperators #-}

5{-# LANGUAGE ScopedTypeVariables #-}

6−{-# LANGUAGE LambdaCase, MultiWayIf #-}

7-- | Vty supports a configuration file format and associated 'Config'

6-- | Vty supports a configuration file format and associated 'Config'

8-- data type. The 'Config' can be provided to 'mkVty' to customize the

7-- data type. The 'Config' can be provided to 'mkVty' to customize the

9-- application's use of Vty.

8-- application's use of Vty.

@@ -123,7 +122,6 @@ import Data.Semigroup (Semigroup(..))

123import Data.Typeable (Typeable)

122import Data.Typeable (Typeable)

124

123

125import Graphics.Vty.Input.Events

124import Graphics.Vty.Input.Events

126−import Graphics.Vty.Attributes.Color (ColorMode(..), detectColorMode)

127

125

128import GHC.Generics

126import GHC.Generics

129

127

@@ -195,9 +193,6 @@ data Config =

195 -- configuration specifies one. If no custom table is loaded

193 -- configuration specifies one. If no custom table is loaded

196 -- (or if a load fails), the built-in character width table

194 -- (or if a load fails), the built-in character width table

197 -- will be used.

195 -- will be used.

198− , colorMode :: Maybe ColorMode

199− -- ^ The color mode used to know how many colors the terminal

200− -- supports.

201 }

196 }

202 deriving (Show, Eq)

197 deriving (Show, Eq)

203

198

@@ -219,7 +214,6 @@ instance Semigroup Config where

219 , termWidthMaps = termWidthMaps c1 <|> termWidthMaps c0

214 , termWidthMaps = termWidthMaps c1 <|> termWidthMaps c0

220 , allowCustomUnicodeWidthTables =

215 , allowCustomUnicodeWidthTables =

221 allowCustomUnicodeWidthTables c1 <|> allowCustomUnicodeWidthTables c0

216 allowCustomUnicodeWidthTables c1 <|> allowCustomUnicodeWidthTables c0

222− , colorMode = colorMode c1 <|> colorMode c0

223 }

217 }

224

218

225instance Monoid Config where

219instance Monoid Config where

@@ -235,7 +229,6 @@ instance Monoid Config where

235 , termName = Nothing

229 , termName = Nothing

236 , termWidthMaps = []

230 , termWidthMaps = []

237 , allowCustomUnicodeWidthTables = Nothing

231 , allowCustomUnicodeWidthTables = Nothing

238− , colorMode = Nothing

239 }

232 }

240#if !(MIN_VERSION_base(4,11,0))

233#if !(MIN_VERSION_base(4,11,0))

241 mappend = (<>)

234 mappend = (<>)

@@ -291,8 +284,7 @@ standardIOConfig = do

291 mb <- lookupEnv termVariable

284 mb <- lookupEnv termVariable

292 case mb of

285 case mb of

293 Nothing -> throwIO VtyMissingTermEnvVar

286 Nothing -> throwIO VtyMissingTermEnvVar

294− Just t -> do

287+ Just t ->

295− mcolorMode <- detectColorMode t

296 return defaultConfig

288 return defaultConfig

297 { vmin = Just 1

289 { vmin = Just 1

298 , mouseMode = Just False

290 , mouseMode = Just False

@@ -301,7 +293,6 @@ standardIOConfig = do

301 , inputFd = Just stdInput

293 , inputFd = Just stdInput

302 , outputFd = Just stdOutput

294 , outputFd = Just stdOutput

303 , termName = Just t

295 , termName = Just t

304− , colorMode = Just mcolorMode

305 }

296 }

306

297

307parseConfigFile :: FilePath -> IO Config

298parseConfigFile :: FilePath -> IO Config

src/Graphics/Vty/Image.hs+1−1

@@ -137,7 +137,7 @@ char a c =

137 let displayWidth = safeWcwidth c

138 in HorizText a (TL.singleton c) displayWidth 1

139

140−-- | Make an image from a string of characters laid out on a single

140+-- | Make an image from a string of characters layed out on a single

141-- row with the same display attribute. The string is assumed to be a

142-- sequence of ISO-10646 characters. The input string should be

143-- sanitized of escape sequences (ASCII 27) and carriage returns;

src/Graphics/Vty/Image/Internal.hs+2−2

@@ -228,7 +228,7 @@ instance Monoid Image where

228--

229-- The result image will have a width equal to the sum of the two images

230-- width. And the height will equal the largest height of the two

231−-- images. The area not defined in one image due to a height mismatch

231+-- images. The area not defined in one image due to a height missmatch

232-- will be filled with the background pattern.

233horizJoin :: Image -> Image -> Image

234horizJoin EmptyImage i = i

@@ -259,7 +259,7 @@ horizJoin _ _ = error "horizJoin applied to undefined values."

259--

260-- The result image will have a height equal to the sum of the heights

261-- of both images. The width will equal the largest width of the two

262−-- images. The area not defined in one image due to a width mismatch

262+-- images. The area not defined in one image due to a width missmatch

263-- will be filled with the background pattern.

264vertJoin :: Image -> Image -> Image

265vertJoin EmptyImage i = i

src/Graphics/Vty/Input.hs+2−2

@@ -77,7 +77,7 @@

77-- The input encoding determines how UTF-8 encoded characters are

78-- recognized.

79--

80−-- * 7-bit mode: UTF-8 can be input unambiguously. UTF-8 input is

80+-- * 7-bit mode: UTF-8 can be input unambiguiously. UTF-8 input is

81-- a superset of ASCII. UTF-8 does not overlap escaped control key

82-- sequences. However, the escape key must be differentiated from

83-- escaped control key sequences by the timing of the input bytes.

@@ -95,7 +95,7 @@

95--

96-- == Terminal Input is Broken

97--

98−-- Clearly terminal input has fundamental issues. There is no easy way

98+-- Clearly terminal input has fundemental issues. There is no easy way

99-- to reliably resolve these issues.

100--

101-- One resolution would be to ditch standard terminal interfaces

src/Graphics/Vty/Input/Mouse.hs+2−2

@@ -89,7 +89,7 @@ scrollDown = 65

89hasBitSet :: Int -> Int -> Bool

90hasBitSet val bit = val .&. bit > 0

92−-- | Attempt to classify an input string as a mouse event.

92+-- | Attempt to lassify an input string as a mouse event.

93classifyMouseEvent :: ByteString -> KClass

94classifyMouseEvent s = runParser s $ do

95 when (not $ isMouseEvent s) failParse

@@ -102,7 +102,7 @@ classifyMouseEvent s = runParser s $ do

102 'M' -> classifyNormalMouseEvent

103 _ -> failParse

104

105−-- Given a modifier/button value, determine which button was indicated

105+-- Given a modifer/button value, determine which button was indicated

106getSGRButton :: Int -> Parser Button

107getSGRButton mods =

108 let buttonMap = [ (leftButton, BLeft)

src/Graphics/Vty/Output.hs+4−5

@@ -58,12 +58,11 @@ import Data.Monoid ((<>))

58-- * If TERM contains "xterm" or "screen", use XTermColor.

59-- * otherwise use the TerminfoBased driver.

60outputForConfig :: Config -> IO Output

61−outputForConfig Config{ outputFd = Just fd, termName = Just termName

61+outputForConfig Config{ outputFd = Just fd, termName = Just termName, .. } = do

62− , colorMode = Just colorMode, .. } = do

63 t <- if "xterm" `isPrefixOf` termName || "screen" `isPrefixOf` termName

62 t <- if "xterm" `isPrefixOf` termName || "screen" `isPrefixOf` termName

64− then XTermColor.reserveTerminal termName fd colorMode

63+ then XTermColor.reserveTerminal termName fd

65 -- Not an xterm-like terminal. try for generic terminfo.

64 -- Not an xterm-like terminal. try for generic terminfo.

66− else TerminfoBased.reserveTerminal termName fd colorMode

65+ else TerminfoBased.reserveTerminal termName fd

68 case mouseMode of

67 case mouseMode of

69 Just s -> setMode t Mouse s

68 Just s -> setMode t Mouse s

@@ -78,7 +77,7 @@ outputForConfig config = (<> config) <$> standardIOConfig >>= outputForConfig

79-- | Sets the cursor position to the given output column and row.

78-- | Sets the cursor position to the given output column and row.

80--

79--

81−-- This is not necessarily the same as the character position with the

80+-- This is not necessarially the same as the character position with the

82-- same coordinates. Characters can be a variable number of columns in

81-- same coordinates. Characters can be a variable number of columns in

83-- width.

82-- width.

84--

83--

src/Graphics/Vty/Output/Interface.hs+17−22

@@ -79,6 +79,9 @@ data Output = Output

79 , displayBounds :: IO DisplayRegion

80 -- | Output the bytestring to the terminal device.

81 , outputByteBuffer :: BS.ByteString -> IO ()

82+ -- | Specifies the maximum number of colors supported by the

83+ -- context.

84+ , contextColorCount :: Int

82 -- | Specifies whether the cursor can be shown / hidden.

85 -- | Specifies whether the cursor can be shown / hidden.

83 , supportsCursorVisibility :: Bool

86 , supportsCursorVisibility :: Bool

84 -- | Indicates support for terminal modes for this output device.

87 -- | Indicates support for terminal modes for this output device.

@@ -114,8 +117,6 @@ data Output = Output

114 -- be a reliable indicator of whether the feature will work as

117 -- be a reliable indicator of whether the feature will work as

115 -- desired.

118 -- desired.

116 , supportsStrikethrough :: IO Bool

119 , supportsStrikethrough :: IO Bool

117− -- | Returns how many colors the terminal supports.

118− , outputColorMode :: ColorMode

119 }

120 }

120

121

121displayContext :: Output -> DisplayRegion -> IO DisplayContext

122displayContext :: Output -> DisplayRegion -> IO DisplayContext

@@ -309,23 +310,17 @@ limitAttrForDisplay t attr

309 where

310 where

310 clampColor Default = Default

311 clampColor Default = Default

311 clampColor KeepCurrent = KeepCurrent

312 clampColor KeepCurrent = KeepCurrent

312− clampColor (SetTo c) = clampColor' (outputColorMode t) c

313+ clampColor (SetTo c) = clampColor' c

313−

314− clampColor' NoColor _ = Default

314+ clampColor' (ISOColor v)

315−

315+ | contextColorCount t < 8 = Default

316− clampColor' ColorMode8 (ISOColor v)

317− | v >= 8 = SetTo $ ISOColor (v - 8)

316+ | contextColorCount t < 16 && v >= 8 = SetTo $ ISOColor (v - 8)

318− | otherwise = SetTo $ ISOColor v

317+ | otherwise = SetTo $ ISOColor v

319− clampColor' ColorMode8 _ = Default

318+ clampColor' (Color240 v)

320−

319+ -- Should we choose closest ISO color?

321− clampColor' ColorMode16 c@(ISOColor _) = SetTo c

320+ | contextColorCount t < 8 = Default

322− clampColor' ColorMode16 _ = Default

321+ | contextColorCount t < 16 = Default

323−

322+ | contextColorCount t <= 256 = SetTo $ Color240 v

324− clampColor' (ColorMode240 _) c@(ISOColor _) = SetTo c

325− clampColor' (ColorMode240 colorCount) c@(Color240 n)

326− | n <= colorCount = SetTo c

327− | otherwise = Default

323+ | otherwise

328− clampColor' colorMode@(ColorMode240 _) (RGBColor r g b) =

324+ = let p :: Double = fromIntegral v / 240.0

329− clampColor' colorMode (color240 r g b)

325+ v' = floor $ p * (fromIntegral $ contextColorCount t)

330−

326+ in SetTo $ Color240 v'

331− clampColor' FullColor c = SetTo c

src/Graphics/Vty/Output/Mock.hs+2−3

@@ -11,7 +11,6 @@ module Graphics.Vty.Output.Mock

11where

13import Graphics.Vty.Image (DisplayRegion)

14−import Graphics.Vty.Attributes.Color (ColorMode(ColorMode16))

15import Graphics.Vty.Output.Interface

14import Graphics.Vty.Output.Interface

17import Blaze.ByteString.Builder.Word (writeWord8)

16import Blaze.ByteString.Builder.Word (writeWord8)

@@ -31,7 +30,7 @@ type MockData = IORef (UTF8.UTF8 BS.ByteString)

31-- without considering terminal specific issues.

30-- without considering terminal specific issues.

32--

31--

33-- The mock implementation is useful in manually determining if the

32-- The mock implementation is useful in manually determining if the

34−-- sequence of terminal operations matches the expected sequence. The

33+-- sequence of terminal operations matche the expected sequence. The

35-- requirement of the produced representation is simplicity in parsing

34-- requirement of the produced representation is simplicity in parsing

36-- the text representation and determining how the picture was mapped to

35-- the text representation and determining how the picture was mapped to

37-- terminal operations.

36-- terminal operations.

@@ -56,12 +55,12 @@ mockTerminal r = liftIO $ do

56 , outputByteBuffer = \bytes -> do

55 , outputByteBuffer = \bytes -> do

57 putStrLn $ "mock outputByteBuffer of " ++ show (BS.length bytes) ++ " bytes"

56 putStrLn $ "mock outputByteBuffer of " ++ show (BS.length bytes) ++ " bytes"

58 writeIORef outRef $ UTF8.fromRep bytes

57 writeIORef outRef $ UTF8.fromRep bytes

58+ , contextColorCount = 16

59 , supportsCursorVisibility = True

60 , supportsMode = const False

61 , setMode = const $ const $ return ()

62 , getModeStatus = const $ return False

63 , assumedStateRef = newAssumedStateRef

64− , outputColorMode = ColorMode16

65 , mkDisplayContext = \tActual rActual -> return $ DisplayContext

64 , mkDisplayContext = \tActual rActual -> return $ DisplayContext

66 { contextRegion = rActual

65 { contextRegion = rActual

67 , contextDevice = tActual

66 , contextDevice = tActual

src/Graphics/Vty/Output/TerminfoBased.hs+33−66

@@ -25,7 +25,7 @@ import Graphics.Vty.Image (DisplayRegion)

25import Graphics.Vty.DisplayAttributes

26import Graphics.Vty.Output.Interface

28−import Blaze.ByteString.Builder (Write, writeToByteString, writeStorable, writeWord8)

28+import Blaze.ByteString.Builder (Write, writeToByteString, writeStorable)

30import Data.IORef

31import Data.Maybe (isJust, isNothing, fromJust)

@@ -49,6 +49,7 @@ data TerminfoCaps = TerminfoCaps

49 , cup :: CapExpression

50 , cnorm :: Maybe CapExpression

51 , civis :: Maybe CapExpression

52+ , supportsNoColors :: Bool

52 , useAltColorMap :: Bool

53 , useAltColorMap :: Bool

53 , setForeColor :: CapExpression

54 , setForeColor :: CapExpression

54 , setBackColor :: CapExpression

55 , setBackColor :: CapExpression

@@ -103,28 +104,28 @@ sendCapToTerminal t cap capParams = do

103--

104--

104-- * Providing independent string capabilities for all display

105-- * Providing independent string capabilities for all display

105-- attributes.

106-- attributes.

106−reserveTerminal :: String -> Fd -> ColorMode -> IO Output

107+reserveTerminal :: String -> Fd -> IO Output

107−reserveTerminal termName outFd colorMode = do

108+reserveTerminal termName outFd = do

108 ti <- Terminfo.setupTerm termName

109 ti <- Terminfo.setupTerm termName

109 -- assumes set foreground always implies set background exists.

110 -- assumes set foreground always implies set background exists.

110 -- if set foreground is not set then all color changing style

111 -- if set foreground is not set then all color changing style

111 -- attributes are filtered.

112 -- attributes are filtered.

112 msetaf <- probeCap ti "setaf"

113 msetaf <- probeCap ti "setaf"

113 msetf <- probeCap ti "setf"

114 msetf <- probeCap ti "setf"

114− let (useAlt, setForeCap)

115+ let (noColors, useAlt, setForeCap)

115 = case msetaf of

116 = case msetaf of

116− Just setaf -> (False, setaf)

117+ Just setaf -> (False, False, setaf)

117 Nothing -> case msetf of

118 Nothing -> case msetf of

118− Just setf -> (True, setf)

119+ Just setf -> (False, True, setf)

119− Nothing -> (True, error $ "no fore color support for terminal " ++ termName)

120+ Nothing -> (True, True, error $ "no fore color support for terminal " ++ termName)

120 msetab <- probeCap ti "setab"

121 msetab <- probeCap ti "setab"

121 msetb <- probeCap ti "setb"

122 msetb <- probeCap ti "setb"

122− let setBackCap

123+ let set_back_cap

123 = case msetab of

124 = case msetab of

124− Just setab -> setab

125 Nothing -> case msetb of

126 Just setb -> setb

127 Nothing -> error $ "no back color support for terminal " ++ termName

128+ Just setab -> setab

128

129

129 hyperlinkModeStatus <- newIORef False

130 hyperlinkModeStatus <- newIORef False

130 newAssumedStateRef <- newIORef initialAssumedState

131 newAssumedStateRef <- newIORef initialAssumedState

@@ -150,9 +151,10 @@ reserveTerminal termName outFd colorMode = do

150 <*> requireCap ti "cup"

151 <*> requireCap ti "cup"

151 <*> probeCap ti "cnorm"

152 <*> probeCap ti "cnorm"

152 <*> probeCap ti "civis"

153 <*> probeCap ti "civis"

154+ <*> pure noColors

153 <*> pure useAlt

155 <*> pure useAlt

154 <*> pure setForeCap

156 <*> pure setForeCap

155− <*> pure setBackCap

157+ <*> pure set_back_cap

156 <*> requireCap ti "sgr0"

158 <*> requireCap ti "sgr0"

157 <*> requireCap ti "clear"

159 <*> requireCap ti "clear"

158 <*> requireCap ti "el"

160 <*> requireCap ti "el"

@@ -192,12 +194,17 @@ reserveTerminal termName outFd colorMode = do

192 when (toEnum len /= actualLen) $ fail $ "Graphics.Vty.Output: outputByteBuffer "

194 when (toEnum len /= actualLen) $ fail $ "Graphics.Vty.Output: outputByteBuffer "

193 ++ "length mismatch. " ++ show len ++ " /= " ++ show actualLen

195 ++ "length mismatch. " ++ show len ++ " /= " ++ show actualLen

194 ++ " Please report this bug to vty project."

196 ++ " Please report this bug to vty project."

197+ , contextColorCount

198+ = case supportsNoColors terminfoCaps of

199+ False -> case Terminfo.getCapability ti (Terminfo.tiGetNum "colors" ) of

200+ Nothing -> 8

201+ Just v -> toEnum v

202+ True -> 1

195 , supportsCursorVisibility = isJust $ civis terminfoCaps

203 , supportsCursorVisibility = isJust $ civis terminfoCaps

196 , supportsMode = terminfoModeSupported

204 , supportsMode = terminfoModeSupported

197 , setMode = terminfoSetMode

205 , setMode = terminfoSetMode

198 , getModeStatus = terminfoModeStatus

206 , getModeStatus = terminfoModeStatus

199 , assumedStateRef = newAssumedStateRef

207 , assumedStateRef = newAssumedStateRef

200− , outputColorMode = colorMode

201 -- I think fix would help assure tActual is the only

208 -- I think fix would help assure tActual is the only

202 -- reference. I was having issues tho.

209 -- reference. I was having issues tho.

203 , mkDisplayContext = (`terminfoDisplayContext` terminfoCaps)

210 , mkDisplayContext = (`terminfoDisplayContext` terminfoCaps)

@@ -295,7 +302,7 @@ writeURLEscapes NoLinkChange =

295-- | Portably setting the display attributes is a giant pain in the ass.

302-- | Portably setting the display attributes is a giant pain in the ass.

296--

303--

297-- If the terminal supports the sgr capability (which sets the on/off

304-- If the terminal supports the sgr capability (which sets the on/off

298−-- state of each style directly; and, for no good reason, resets the

305+-- state of each style directly ; and, for no good reason, resets the

299-- colors to the default) this procedure is used:

306-- colors to the default) this procedure is used:

300--

307--

301-- 0. set the style attributes. This resets the fore and back color.

308-- 0. set the style attributes. This resets the fore and back color.

@@ -334,9 +341,9 @@ terminfoWriteSetAttr dc terminfoCaps urlsEnabled prevAttr reqAttr diffs =

334 -- The only way to reset either color, portably, to the default

341 -- The only way to reset either color, portably, to the default

335 -- is to use either the set state capability or the set default

342 -- is to use either the set state capability or the set default

336 -- capability.

343 -- capability.

337− True -> do

344+ True -> do

338 case reqDisplayCapSeqFor (displayAttrCaps terminfoCaps)

345 case reqDisplayCapSeqFor (displayAttrCaps terminfoCaps)

339− (fixedStyle attr)

346+ (fixedStyle attr )

340 (styleToApplySeq $ fixedStyle attr) of

347 (styleToApplySeq $ fixedStyle attr) of

341 -- only way to reset a color to the defaults

348 -- only way to reset a color to the defaults

342 EnterExitSeq caps -> writeDefaultAttr dc urlsEnabled

349 EnterExitSeq caps -> writeDefaultAttr dc urlsEnabled

@@ -369,9 +376,9 @@ terminfoWriteSetAttr dc terminfoCaps urlsEnabled prevAttr reqAttr diffs =

369 -- applied states.

376 -- applied states.

370 EnterExitSeq caps -> foldMap (\cap -> writeCapExpr cap []) caps

377 EnterExitSeq caps -> foldMap (\cap -> writeCapExpr cap []) caps

371 `mappend`

378 `mappend`

372− writeColorDiff Foreground (foreColorDiff diffs)

379+ writeColorDiff setForeColor (foreColorDiff diffs)

373 `mappend`

380 `mappend`

374− writeColorDiff Background (backColorDiff diffs)

381+ writeColorDiff setBackColor (backColorDiff diffs)

375 -- implicitly resets the colors to the defaults

382 -- implicitly resets the colors to the defaults

376 SetState state -> writeCapExpr (fromJust $ setAttrStates

383 SetState state -> writeCapExpr (fromJust $ setAttrStates

377 $ displayAttrCaps terminfoCaps

384 $ displayAttrCaps terminfoCaps

@@ -403,65 +410,29 @@ terminfoWriteSetAttr dc terminfoCaps urlsEnabled prevAttr reqAttr diffs =

403 | otherwise = mempty

410 | otherwise = mempty

404 setColors =

411 setColors =

405 (case fixedForeColor attr of

412 (case fixedForeColor attr of

406− Just c -> writeColor Foreground c

413+ Just c -> writeCapExpr (setForeColor terminfoCaps)

414+ [toEnum $ colorMap c]

407 Nothing -> mempty)

415 Nothing -> mempty)

408 `mappend`

416 `mappend`

409 (case fixedBackColor attr of

417 (case fixedBackColor attr of

410− Just c -> writeColor Background c

418+ Just c -> writeCapExpr (setBackColor terminfoCaps)

419+ [toEnum $ colorMap c]

411 Nothing -> mempty)

420 Nothing -> mempty)

412− writeColorDiff _side NoColorChange

421+ writeColorDiff _f NoColorChange

413 = mempty

422 = mempty

414− writeColorDiff _side ColorToDefault

423+ writeColorDiff _f ColorToDefault

415 = error "ColorToDefault is not a possible case for applyColorDiffs"

424 = error "ColorToDefault is not a possible case for applyColorDiffs"

416− writeColorDiff side (SetColor c)

425+ writeColorDiff f (SetColor c)

417− = writeColor side c

418−

419− writeColor side (RGBColor r g b) =

420− case outputColorMode (contextDevice dc) of

421− FullColor ->

422− hardcodeColor side (r, g, b)

423− _ ->

424− error "clampColor should remove rgb colors in standard mode"

425− writeColor side c =

426− writeCapExpr (setSideColor side terminfoCaps) [toEnum $ colorMap c]

426+ = writeCapExpr (f terminfoCaps) [toEnum $ colorMap c]

427−

428−-- a color can either be in the foreground or the background

429−data ColorSide = Foreground | Background

430−

431−-- get the capability for drawing a color on a specific side

432−setSideColor :: ColorSide -> TerminfoCaps -> CapExpression

433−setSideColor Foreground = setForeColor

434−setSideColor Background = setBackColor

435−

436−hardcodeColor :: ColorSide -> (Word8, Word8, Word8) -> Write

437−hardcodeColor side (r, g, b) =

438− -- hardcoded color codes are formatted as "\x1b[{side};2;{r};{g};{b}m"

439− mconcat [ writeStr "\x1b[", sideCode, delimiter, writeChar '2', delimiter

440− , writeColor r, delimiter, writeColor g, delimiter, writeColor b

441− , writeChar 'm']

442− where

443− writeChar = writeWord8 . fromIntegral . fromEnum

444− writeStr = mconcat . map writeChar

445− writeColor = writeStr . show

446− delimiter = writeChar ';'

447− -- 38/48 are used to set whether we should write to the

448− -- foreground/background. I really don't want to know why.

449− sideCode = case side of

450− Foreground -> writeStr "38"

451− Background -> writeStr "48"

452

427

453-- | The color table used by a terminal is a 16 color set followed by a

428-- | The color table used by a terminal is a 16 color set followed by a

454-- 240 color set that might not be supported by the terminal.

429-- 240 color set that might not be supported by the terminal.

455--

430--

456−-- This takes a Color which clearly identifies which palette to use and

431+-- This takes a Color which clearly identifies which pallete to use and

457−-- computes the index into the full 256 color palette.

432+-- computes the index into the full 256 color pallete.

458ansiColorIndex :: Color -> Int

433ansiColorIndex :: Color -> Int

459ansiColorIndex (ISOColor v) = fromEnum v

434ansiColorIndex (ISOColor v) = fromEnum v

460ansiColorIndex (Color240 v) = 16 + fromEnum v

435ansiColorIndex (Color240 v) = 16 + fromEnum v

461−ansiColorIndex (RGBColor _ _ _) =

462− error $ unlines [ "Attempted to create color index from rgb color."

463− , "This is currently unsupported, and shouldn't ever happen"

464− ]

465

436

466-- | For terminals without setaf/setab

437-- | For terminals without setaf/setab

467--

438--

@@ -478,10 +449,6 @@ altColorIndex (ISOColor 6) = 3

478altColorIndex (ISOColor 7) = 7

449altColorIndex (ISOColor 7) = 7

479altColorIndex (ISOColor v) = fromEnum v

450altColorIndex (ISOColor v) = fromEnum v

480altColorIndex (Color240 v) = 16 + fromEnum v

451altColorIndex (Color240 v) = 16 + fromEnum v

481−altColorIndex (RGBColor _ _ _) =

482− error $ unlines [ "Attempted to create color index from rgb color."

483− , "This is currently unsupported, and shouldn't ever happen"

484− ]

485

452

486{- | The sequence of terminfo caps to apply a given style are determined

453{- | The sequence of terminfo caps to apply a given style are determined

487 - according to these rules.

454 - according to these rules.

src/Graphics/Vty/Output/XTermColor.hs+3−4

@@ -10,7 +10,6 @@ where

10import Graphics.Vty.Output.Interface

11import Graphics.Vty.Input.Mouse

12import Graphics.Vty.Input.Focus

13−import Graphics.Vty.Attributes.Color (ColorMode)

14import qualified Graphics.Vty.Output.TerminfoBased as TerminfoBased

13import qualified Graphics.Vty.Output.TerminfoBased as TerminfoBased

16import Blaze.ByteString.Builder (writeToByteString)

15import Blaze.ByteString.Builder (writeToByteString)

@@ -43,8 +42,8 @@ fdWrite fd s =

43 fdWriteBuf fd (castPtr buf) (fromIntegral len)

42 fdWriteBuf fd (castPtr buf) (fromIntegral len)

45-- | Construct an Xterm output driver. Initialize the display to UTF-8.

44-- | Construct an Xterm output driver. Initialize the display to UTF-8.

46−reserveTerminal :: ( Applicative m, MonadIO m ) => String -> Fd -> ColorMode -> m Output

45+reserveTerminal :: ( Applicative m, MonadIO m ) => String -> Fd -> m Output

47−reserveTerminal variant outFd colorMode = liftIO $ do

46+reserveTerminal variant outFd = liftIO $ do

48 let flushedPut = void . fdWrite outFd

47 let flushedPut = void . fdWrite outFd

49 -- If the terminal variant is xterm-color use xterm instead since,

48 -- If the terminal variant is xterm-color use xterm instead since,

50 -- more often than not, xterm-color is broken.

49 -- more often than not, xterm-color is broken.

@@ -52,7 +51,7 @@ reserveTerminal variant outFd colorMode = liftIO $ do

53 utf8a <- utf8Active

52 utf8a <- utf8Active

54 when (not utf8a) $ flushedPut setUtf8CharSet

53 when (not utf8a) $ flushedPut setUtf8CharSet

55− t <- TerminfoBased.reserveTerminal variant' outFd colorMode

54+ t <- TerminfoBased.reserveTerminal variant' outFd

57 mouseModeStatus <- newIORef False

56 mouseModeStatus <- newIORef False

58 focusModeStatus <- newIORef False

57 focusModeStatus <- newIORef False

src/Graphics/Vty/PictureToSpans.hs+1−1

@@ -72,7 +72,7 @@ displayOpsForPic pic r = Vector.create (combinedOpsForLayers pic r)

72-- | Returns the DisplayOps for an image rendered to a window the size

73-- of the image.

74--

75−-- largely used only for debugging.

75+-- largerly used only for debugging.

76displayOpsForImage :: Image -> DisplayOps

77displayOpsForImage i = displayOpsForPic (picForImage i) (imageWidth i, imageHeight i)

test/VerifyImageOps.hs+1−1

@@ -137,7 +137,7 @@ cropBottomLimitsHeight :: Image -> Int -> Property

137cropBottomLimitsHeight i v = v >= 0 ==>

138 v >= imageHeight (cropBottom v i)

139

140−-- ridiculous tests just to satisfy my desire for nice code coverage :-P

140+-- rediculous tests just to satisfy my desire for nice code coverage :-P

141canShowImage :: Image -> Bool

142canShowImage i = length (show i) > 0

143

test/VerifyOutput.hs+2−6

@@ -1,4 +1,4 @@

1−-- We setup the environment to invoke certain terminals of interest.

1+-- We setup the environment to envoke certain terminals of interest.

2-- This assumes appropriate definitions exist in the current environment

3-- for the terminals of interest.

4{-# LANGUAGE ScopedTypeVariables #-}

@@ -35,11 +35,7 @@ smokeTestTermNonMac termName i = liftIOResult $ do

35smokeTestTerm :: String -> Image -> IO Result

36smokeTestTerm termName i = do

37 nullOut <- openFd "/dev/null" WriteOnly Nothing defaultFileFlags

38− t <- outputForConfig $ defaultConfig

38+ t <- outputForConfig $ defaultConfig { outputFd = Just nullOut, termName = Just termName }

39− { outputFd = Just nullOut

40− , termName = Just termName

41− , colorMode = Just NoColor

42− }

43 -- putStrLn $ "context color count: " ++ show (contextColorCount t)

39 -- putStrLn $ "context color count: " ++ show (contextColorCount t)

44 reserveDisplay t

40 reserveDisplay t

45 dc <- displayContext t (100,100)

41 dc <- displayContext t (100,100)

test/VerifyUsingMockInput.hs+1−3

@@ -132,9 +132,7 @@ assertEventsFromSynInput table inputSpec expectedEvents = do

132 readLoop 0 = return ()

133 readLoop n = do

134 e <- atomically $ readTChan $ input^.eventChannel

135− case e of

136− InputEvent ev -> modifyIORef eventsRef ((:) ev)

135+ modifyIORef eventsRef ((:) e)

137− ResumeAfterSignal -> return ()

138 readLoop (n - 1)

136 readLoop (n - 1)

139 genEventsUsingIoActions maxDuration writeWaitClose readEvents

137 genEventsUsingIoActions maxDuration writeWaitClose readEvents

140 outEvents <- reverse <$> readIORef eventsRef

138 outEvents <- reverse <$> readIORef eventsRef

test/interactive_terminal_test.hs+1−1

@@ -364,7 +364,7 @@ Did the test output match the description?

364|]

365 defaultSuccessConfirmResults

366

367−-- Explicitly define the bytes that encode each example text.

367+-- Explicitely definethe bytes that encode each example text.

368-- This avoids any issues with how the compiler represents string literals.

369--

370-- This document is UTF-8 encoded so the UTF-8 string is still included for

vty.cabal+1−1

@@ -1,5 +1,5 @@

1name: vty

2−version: 5.35.1

2+version: 5.34

3license: BSD3

4license-file: LICENSE

5author: AUTHORS