on ffdd86d help sign in
43 files changed+355−972
since splitsnapshots
unifiedsplit
CHANGELOG.md−111 demos/Demo.hs+4−12 src/Codec/Binary/UTF8/Debug.hs+2−1 src/Data/Sequence/Extra.hs+1−1 src/Data/Terminfo/Eval.hs+3−3 src/Data/Terminfo/Parse.hs+10−10 src/Graphics/Vty.hs+10−14 src/Graphics/Vty/Attributes.hs+46−8 src/Graphics/Vty/Attributes/Color.hs+3−67 src/Graphics/Vty/Attributes/Color240.hs+1−1 src/Graphics/Vty/Config.hs+2−11 src/Graphics/Vty/DisplayAttributes.hs−3 src/Graphics/Vty/Image.hs+2−1 src/Graphics/Vty/Image/Internal.hs+3−3 src/Graphics/Vty/Inline.hs+7−5 src/Graphics/Vty/Input.hs+4−3 src/Graphics/Vty/Input/Classify.hs+29−53 src/Graphics/Vty/Input/Classify/Parse.hs+7−10 src/Graphics/Vty/Input/Classify/Types.hs+1−7 src/Graphics/Vty/Input/Events.hs+6−24 src/Graphics/Vty/Input/Focus.hs+13−15 src/Graphics/Vty/Input/Loop.hs+23−42 src/Graphics/Vty/Input/Mouse.hs+17−19 src/Graphics/Vty/Input/Paste.hs+24−16 src/Graphics/Vty/Input/Terminfo.hs+4−6 src/Graphics/Vty/Input/Terminfo/ANSIVT.hs+1−1 src/Graphics/Vty/Output.hs+5−6 src/Graphics/Vty/Output/Interface.hs+18−45 src/Graphics/Vty/Output/Mock.hs+2−5 src/Graphics/Vty/Output/TerminfoBased.hs+40−96 src/Graphics/Vty/Output/XTermColor.hs+15−27 src/Graphics/Vty/Picture.hs+1−8 src/Graphics/Vty/PictureToSpans.hs+4−4 src/Graphics/Vty/Span.hs+4−2 test/VerifyColor240.hs−269 test/VerifyEmptyImageProps.hs−1 test/VerifyEvalTerminfoCaps.hs−1 test/VerifyImageOps.hs+1−2 test/VerifyOutput.hs+2−7 test/VerifyParseTerminfoCaps.hs−1 test/VerifyUsingMockInput.hs+1−4 test/interactive_terminal_test.hs+1−1 vty.cabal+38−46
CHANGELOG.md−111
@@ -1,115 +1,4 @@
11
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−
40−5.34
41−----
42−
43−API changes:
44− * Added an `NFData` instance for `Event` (thanks Mario Lang)
45− * Removed `Monoid` and `Semigroup` instances for `Attr` and
46− `MaybeDefault`. This change removed the instances because they were
47− misbehaved; merging `Attr` and `MaybeDefault` values with these
48− instances resulted in field value losses. For example, before this
49− change,
50−```
51−(defAttr `withForeColor` blue) <> (defAttr `withBackColor` green)
52−```
53− would result in just
54−```
55− (defAttr `withBackColor` green)
56−```
57− because the instances were designed to favor the right-hand
58− arguments' fields even if they had not been explicitly set
59− (a consequence of the `MaybeDefault` `Semigroup` instance).
60− While that behavior was sensible specifically in the context of
61− `Graphics.Vty.Inline`, it wasn't a useful user-facing API and it made
62− for surprising instance behavior. Since there is actually no good way
63− to handle this in a `Semigroup` instance for `Attr` -- some choices
64− have to be made about how to merge two attributes' foreground colors,
65− and that won't be much better than what we had -- the instance was
66− just removed.
67−
68−
69−5.33
70−----
71−
72−API changes:
73−* The `Cursor` type got a new `PositionOnly` constructor for cursor
74− placement without visibility.
75−
76−Package changes:
77−* Relaxed upper bound for `random`
78−* Updated `microlens` bounds to allow 0.4.12
79−
80−Other improvements:
81−* Various hlint-driven improvements (thanks Willem Van Onsem)
82−* The implementation of `color240` was improved (thanks (Willem Van
83− Onsem)
84−
85−5.32
86−----
87−
88−New features:
89− * Meta-PageUp and Meta-PageDown are now supported (#193)
90− * Added `supportsItalics` and `supportsStrikethrough` functions to
91− check for feature support in terminfo
92−
93−Bug fixes:
94− * Detect utf-8 mode in `LANG` regardless of case (thanks Emeka
95− Nkurumeh)
96−
97−5.31
98−----
99−
100−New features and API changes:
101− * Added support for strikethrough mode. This change adds a new
102− `strikethrough` `Style` value and uses the `smxx` and `rmxx`
103− Terminfo capabilities to activate and deactivate strikethrough mode,
104− respectively. If the terminfo does not report those capabilities,
105− this style is ignored.
106− * `Output`: added the `setDisplayBounds` field to set the output
107− dimensions of the output handle; added an implementation of this for
108− the `TerminfoBased` backend.
109−
110−Other changes:
111− * The C prototype for `vty_c_get_window_size` in `gwinsz.h` was fixed.
112−
11325.30
1143----
1154
demos/Demo.hs+4−12
@@ -31,8 +31,7 @@ introText = vertCat $ map (string defAttr)
3131 [ "this line is hidden by the top layer"
3232 , "The vty demo program will echo the events generated by the pressed keys."
3333 , "Below there is a 240 color box."
34− , "Followed by a description of the 16 color palette."
35− , "Followed by tones of red using a 24-bit palette."
34+ , "Followed by a description of the 16 color pallete."
3635 , "If the 240 color box is not visible then the terminal"
3736 , "claims 240 colors are not supported."
3837 , "Try setting TERM to xterm-256color"
@@ -43,19 +42,12 @@ introText = vertCat $ map (string defAttr)
4342 , "¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯"
4443 ]
4544
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−
5545colorbox_240 :: Image
5646colorbox_240 = vertCat $ map horizCat $ splitColorImages colorImages
5747 where
5848 colorImages = map (\i -> string (currentAttr `withBackColor` Color240 i) " ") [0..239]
49+ splitColorImages [] = []
50+ splitColorImages is = (take 20 is ++ [string defAttr " "]) : (splitColorImages (drop 20 is))
5951
6052colorbox_16 :: Image
6153colorbox_16 = border <|> column0 <|> border <|> column1 <|> border <|> column2 <|> border
@@ -78,7 +70,7 @@ updateDisplay = do
7870 "Press ESC to exit. Events for keys below."
7971 eventLog <- foldMap (string defAttr) <$> get
8072 let pic = picForImage (info <-> eventLog)
81− `addToBottom` (introText <-> colorbox_240 <|> colorbox_16 <|> fullcolorbox)
73+ `addToBottom` (introText <-> colorbox_240 <|> colorbox_16)
8274 vty <- ask
8375 liftIO $ update vty pic
8476
src/Codec/Binary/UTF8/Debug.hs+2−1
@@ -14,4 +14,5 @@ utf8FromIso :: [Int] -> [Word8]
1414utf8FromIso = encode . map toEnum
1515
1616ppUtf8 :: [Int] -> IO ()
17−ppUtf8 = print . map (`showHex` "") . utf8FromIso
17+ppUtf8 = print . map (\f -> f "") . map showHex . utf8FromIso
18+
src/Data/Sequence/Extra.hs+1−1
@@ -7,7 +7,7 @@ import Data.Sequence
77import Control.Parallel.Strategies
88
99instance NFData a => NFData (Seq a) where
10− rnf = rnf' . viewl
10+ rnf = \v -> rnf' (viewl v)
1111 where
1212 rnf' EmptyL = ()
1313 rnf' (a :< r) = rnf a >| rnf' (viewl r)
src/Data/Terminfo/Eval.hs+3−3
@@ -42,7 +42,7 @@ pop = do
4242
4343readParam :: Word -> Eval CapParam
4444readParam pn = do
45− !params <- evalParams <$> get
45+ !params <- get >>= return . evalParams
4646 return $! genericIndex params pn
4747
4848push :: CapParam -> Eval ()
@@ -64,11 +64,11 @@ writeCapExpr cap params =
6464 in snd $ runWriter (runStateT (writeCapOps (capOps cap)) s0)
6565
6666writeCapOps :: CapOps -> Eval ()
67−writeCapOps = mapM_ writeCapOp
67+writeCapOps ops = mapM_ writeCapOp ops
6868
6969writeCapOp :: CapOp -> Eval ()
7070writeCapOp (Bytes !offset !count) = do
71− !cap <- evalExpression <$> get
71+ !cap <- get >>= return . evalExpression
7272 let bytes = Vector.take count $ Vector.drop offset (capBytes cap)
7373 Vector.forM_ bytes $ tell.writeWord8
7474writeCapOp DecOut = do
src/Data/Terminfo/Parse.hs+10−10
@@ -1,9 +1,9 @@
11{-# LANGUAGE BangPatterns #-}
22{-# LANGUAGE CPP #-}
3+{-# OPTIONS_HADDOCK hide #-}
34{-# LANGUAGE NoMonomorphismRestriction #-}
4−{-# LANGUAGE ScopedTypeVariables #-}
5+{-# LANGUAGE NamedFieldPuns #-}
56{-# OPTIONS_GHC -funbox-strict-fields -O #-}
6−{-# OPTIONS_HADDOCK hide #-}
77
88module Data.Terminfo.Parse
99 ( module Data.Terminfo.Parse
@@ -39,7 +39,7 @@ instance Show CapExpression where
3939 ++ " <= " ++ show (sourceString c)
4040 where
4141 hexDump :: [Word8] -> String
42− hexDump = foldr showHex ""
42+ hexDump = foldr (\b s -> showHex b s) ""
4343
4444instance NFData CapExpression where
4545 rnf (CapExpression ops !_bytes !str !c !pOps)
@@ -99,7 +99,7 @@ parseCapExpression capString =
9999 Left e -> Left e
100100 Right buildResults -> Right $ constructCapExpression capString buildResults
101101
102−constructCapExpression :: String -> BuildResults -> CapExpression
102+constructCapExpression :: [Char] -> BuildResults -> CapExpression
103103constructCapExpression capString buildResults =
104104 let expr = CapExpression
105105 { capOps = outCapOps buildResults
@@ -128,7 +128,7 @@ paramEscapeParser = do
128128literalPercentParser :: CapParser BuildResults
129129literalPercentParser = do
130130 _ <- char '%'
131− startOffset <- nextOffset <$> getState
131+ startOffset <- getState >>= return . nextOffset
132132 incOffset 1
133133 return $ BuildResults 0 [Bytes startOffset 1] []
134134
@@ -154,7 +154,7 @@ incrementOpParser = do
154154pushOpParser :: CapParser BuildResults
155155pushOpParser = do
156156 _ <- char 'p'
157− paramN <- read . pure <$> digit
157+ paramN <- digit >>= return . (\d -> read [d])
158158 incOffset 2
159159 return $ BuildResults (fromEnum paramN) [PushParam $ paramN - 1] []
160160
@@ -299,7 +299,7 @@ compareOpParser
299299bytesOpParser :: CapParser BuildResults
300300bytesOpParser = do
301301 bytes <- many1 $ satisfy (/= '%')
302− startOffset <- nextOffset <$> getState
302+ startOffset <- getState >>= return . nextOffset
303303 let !c = length bytes
304304 !s <- getState
305305 let s' = s { nextOffset = startOffset + c }
@@ -336,9 +336,9 @@ data BuildResults = BuildResults
336336instance Semigroup BuildResults where
337337 v0 <> v1
338338 = BuildResults
339− { outParamCount = outParamCount v0 `max` outParamCount v1
340− , outCapOps = outCapOps v0 <> outCapOps v1
341− , outParamOps = outParamOps v0 <> outParamOps v1
339+ { outParamCount = (outParamCount v0) `max` (outParamCount v1)
340+ , outCapOps = (outCapOps v0) <> (outCapOps v1)
341+ , outParamOps = (outParamOps v0) <> (outParamOps v1)
342342 }
343343
344344instance Monoid BuildResults where
src/Graphics/Vty.hs+10−14
@@ -1,5 +1,4 @@
11{-# LANGUAGE CPP #-}
2−{-# LANGUAGE ScopedTypeVariables #-}
32
43-- | Vty provides interfaces for both terminal input and terminal
54-- output.
@@ -48,7 +47,6 @@ where
4847
4948import Graphics.Vty.Config
5049import Graphics.Vty.Input
51−import Graphics.Vty.Input.Events
5250import Graphics.Vty.Output
5351import Graphics.Vty.Output.Interface
5452import Graphics.Vty.Picture
@@ -168,7 +166,7 @@ internalMkVty :: Input -> Output -> IO Vty
168166internalMkVty input out = do
169167 reserveDisplay out
170168
171− shutdownVar <- newTVarIO False
169+ shutdownVar <- atomically $ newTVar False
172170 let shutdownIo = do
173171 alreadyShutdown <- atomically $ swapTVar shutdownVar True
174172 when (not alreadyShutdown) $ do
@@ -176,7 +174,7 @@ internalMkVty input out = do
176174 releaseDisplay out
177175 releaseTerminal out
178176
179− let shutdownStatus = readTVarIO shutdownVar
177+ let shutdownStatus = atomically $ readTVar shutdownVar
180178
181179 lastPicRef <- newIORef Nothing
182180 lastUpdateRef <- newIORef Nothing
@@ -210,18 +208,16 @@ internalMkVty input out = do
210208 maybe (return ()) innerUpdate mPic
211209
212210 let mkResize = uncurry EvResize <$> displayBounds out
213−
214− translateInternalEvent ResumeAfterSignal = mkResize
215− translateInternalEvent (InputEvent e) = return e
216−
217211 gkey = do
218− e <- atomically $ readTChan $ _eventChannel input
219− translateInternalEvent e
212+ k <- atomically $ readTChan $ _eventChannel input
213+ case k of
214+ (EvResize _ _) -> mkResize
215+ _ -> return k
220216 gkey' = do
221− mEv <- atomically $ tryReadTChan $ _eventChannel input
222− case mEv of
223− Just e -> Just <$> translateInternalEvent e
224− Nothing -> return Nothing
217+ k <- atomically $ tryReadTChan $ _eventChannel input
218+ case k of
219+ (Just (EvResize _ _)) -> Just <$> mkResize
220+ _ -> return k
225221
226222 return $ Vty { update = innerUpdate
227223 , nextEvent = gkey
src/Graphics/Vty/Attributes.hs+46−8
@@ -1,4 +1,7 @@
11{-# LANGUAGE CPP #-}
2+{-# LANGUAGE StandaloneDeriving #-}
3+{-# LANGUAGE GADTs #-}
4+{-# LANGUAGE RankNTypes #-}
25{-# LANGUAGE DeriveGeneric #-}
36{-# LANGUAGE DeriveAnyClass #-}
47
@@ -40,7 +43,6 @@ module Graphics.Vty.Attributes
4043 , withStyle
4144 , standout
4245 , italic
43− , strikethrough
4446 , underline
4547 , reverseVideo
4648 , blink
@@ -61,6 +63,9 @@ where
6163
6264import Control.DeepSeq
6365import Data.Bits
66+#if !(MIN_VERSION_base(4,11,0))
67+import Data.Semigroup
68+#endif
6469import Data.Text (Text)
6570import Data.Word
6671import GHC.Generics
@@ -113,6 +118,19 @@ data Attr = Attr
113118-- Then the foreground color encoded into 8 bits.
114119-- Then the background color encoded into 8 bits.
115120
121+instance Semigroup Attr where
122+ attr0 <> attr1 =
123+ Attr ( attrStyle attr0 <> attrStyle attr1 )
124+ ( attrForeColor attr0 <> attrForeColor attr1 )
125+ ( attrBackColor attr0 <> attrBackColor attr1 )
126+ ( attrURL attr0 <> attrURL attr1 )
127+
128+instance Monoid Attr where
129+ mempty = Attr mempty mempty mempty mempty
130+#if !(MIN_VERSION_base(4,11,0))
131+ mappend = (<>)
132+#endif
133+
116134-- | Specifies the display attributes such that the final style and
117135-- color values do not depend on the previously applied display
118136-- attribute. The display attributes can still depend on the terminal's
@@ -127,20 +145,43 @@ data FixedAttr = FixedAttr
127145-- | The style and color attributes can either be the terminal defaults.
128146-- Or be equivalent to the previously applied style. Or be a specific
129147-- value.
130−data MaybeDefault v = Default | KeepCurrent | SetTo !v
131− deriving (Eq, Read, Show)
148+data MaybeDefault v where
149+ Default :: MaybeDefault v
150+ KeepCurrent :: MaybeDefault v
151+ SetTo :: forall v . ( Eq v, Show v, Read v ) => !v -> MaybeDefault v
132152
133153instance (NFData v) => NFData (MaybeDefault v) where
134154 rnf Default = ()
135155 rnf KeepCurrent = ()
136156 rnf (SetTo v) = rnf v
137157
158+deriving instance Eq v => Eq (MaybeDefault v)
159+deriving instance Eq v => Show (MaybeDefault v)
160+deriving instance (Eq v, Show v, Read v) => Read (MaybeDefault v)
161+
162+instance Eq v => Semigroup (MaybeDefault v) where
163+ Default <> Default = Default
164+ Default <> KeepCurrent = Default
165+ Default <> SetTo v = SetTo v
166+ KeepCurrent <> Default = Default
167+ KeepCurrent <> KeepCurrent = KeepCurrent
168+ KeepCurrent <> SetTo v = SetTo v
169+ SetTo _v <> Default = Default
170+ SetTo v <> KeepCurrent = SetTo v
171+ SetTo _ <> SetTo v = SetTo v
172+
173+instance Eq v => Monoid ( MaybeDefault v ) where
174+ mempty = KeepCurrent
175+#if !(MIN_VERSION_base(4,11,0))
176+ mappend = (<>)
177+#endif
178+
138179-- | Styles are represented as an 8 bit word. Each bit in the word is 1
139180-- if the style attribute assigned to that bit should be applied and 0
140181-- if the style attribute should not be applied.
141182type Style = Word8
142183
143−-- | Valid style attributes include:
184+-- | The 7 possible style attributes:
144185--
145186-- * standout
146187--
@@ -156,11 +197,9 @@ type Style = Word8
156197--
157198-- * italic
158199--
159−-- * strikethrough (via the smxx/rmxx terminfo capabilities)
160−--
161200-- (The invisible, protect, and altcharset display attributes some
162201-- terminals support are not supported via VTY.)
163−standout, underline, reverseVideo, blink, dim, bold, italic, strikethrough :: Style
202+standout, underline, reverseVideo, blink, dim, bold, italic :: Style
164203standout = 0x01
165204underline = 0x02
166205reverseVideo = 0x04
@@ -168,7 +207,6 @@ blink = 0x08
168207dim = 0x10
169208bold = 0x20
170209italic = 0x40
171−strikethrough = 0x80
172210
173211defaultStyleMask :: Style
174212defaultStyleMask = 0x00
src/Graphics/Vty/Attributes/Color.hs+3−67
@@ -1,14 +1,8 @@
11{-# LANGUAGE DeriveGeneric #-}
22{-# LANGUAGE DeriveAnyClass #-}
3−{-# LANGUAGE MultiWayIf #-}
4−{-# LANGUAGE ScopedTypeVariables #-}
53
64module Graphics.Vty.Attributes.Color
75 ( Color(..)
8− , ColorMode(..)
9−
10− -- * Detecting Terminal Color Support
11− , detectColorMode
126
137 -- ** Fixed Colors
148 -- | Standard 8-color ANSI terminal color codes.
@@ -38,10 +32,7 @@ module Graphics.Vty.Attributes.Color
3832 , brightCyan
3933 , brightWhite
4034 -- ** Creating Colors From RGB
41− , linearColor
42− , srgbColor
4335 , rgbColor
44− , color240
4536 , module Graphics.Vty.Attributes.Color240
4637 )
4738where
@@ -49,11 +40,6 @@ where
4940import Data.Word
5041import GHC.Generics
5142import 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
5743
5844import Graphics.Vty.Attributes.Color240
5945
@@ -95,7 +81,7 @@ import Graphics.Vty.Attributes.Color240
9581-- reported then the color reproduction will be incorrect.
9682--
9783-- 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
9985-- the RGB points for the "bright" colors which is why they are not
10086-- addressable via the 240 color palette.
10187--
@@ -109,33 +95,9 @@ import Graphics.Vty.Attributes.Color240
10995-- terminfo but I don't know it.
11096--
11197-- Seriously, terminal color support is INSANE.
112−data Color = ISOColor !Word8 | Color240 !Word8 | RGBColor !Word8 !Word8 !Word8
98+data Color = ISOColor !Word8 | Color240 !Word8
11399 deriving ( Eq, Show, Read, Generic, NFData )
114100
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−
139101black, red, green, yellow, blue, magenta, cyan, white :: Color
140102black = ISOColor 0
141103red = ISOColor 1
@@ -157,35 +119,9 @@ brightMagenta= ISOColor 13
157119brightCyan = ISOColor 14
158120brightWhite = ISOColor 15
159121
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)
186122
187123-- | Create a Vty 'Color' (in the 240 color set) from an RGB triple.
188124-- This function is lossy in the sense that we only internally support 240 colors but the
189125-- #RRGGBB format supports 16^3 colors.
190126rgbColor :: Integral i => i -> i -> i -> Color
191−rgbColor = color240
127+rgbColor r g b = Color240 (rgbColorToColor240 r g b)
src/Graphics/Vty/Attributes/Color240.hs+1−1
@@ -49,7 +49,7 @@ simpleColor_ :: Integral i => Word8 -> i -> Word8
4949simpleColor_ e c
5050 | c <= 0 = 0
5151 | c <= 95 = 1
52− | c <= 255 = fromIntegral ((c-16) `div` 40)
52+ | c <= 255 = fromIntegral ((c-15) `div` 40)
5353 | otherwise = e
5454
5555-- | Create a RGB triple from a value in the Color240 set.
src/Graphics/Vty/Config.hs+2−11
@@ -3,7 +3,6 @@
33{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}
44{-# LANGUAGE TypeOperators #-}
55{-# LANGUAGE ScopedTypeVariables #-}
6−{-# LANGUAGE LambdaCase, MultiWayIf #-}
76-- | Vty supports a configuration file format and associated 'Config'
87-- data type. The 'Config' can be provided to 'mkVty' to customize the
98-- application's use of Vty.
@@ -55,7 +54,7 @@
5554-- If a debug log is requested then vty will output the current input
5655-- table to the log in the above format. A workflow for using this is
5756-- to set @VTY_DEBUG_LOG@. Run the application. Check the debug log for
58−-- incorrect mappings. Add corrected mappings to @$HOME\/.vty\/config@.
57+-- incorrect mappings. Add corrected mappings to @$HOME/.vty/config@.
5958--
6059-- = Unicode Character Width Maps
6160--
@@ -123,7 +122,6 @@ import Data.Semigroup (Semigroup(..))
123122import Data.Typeable (Typeable)
124123
125124import Graphics.Vty.Input.Events
126−import Graphics.Vty.Attributes.Color (ColorMode(..), detectColorMode)
127125
128126import GHC.Generics
129127
@@ -195,9 +193,6 @@ data Config =
195193 -- configuration specifies one. If no custom table is loaded
196194 -- (or if a load fails), the built-in character width table
197195 -- will be used.
198− , colorMode :: Maybe ColorMode
199− -- ^ The color mode used to know how many colors the terminal
200− -- supports.
201196 }
202197 deriving (Show, Eq)
203198
@@ -219,7 +214,6 @@ instance Semigroup Config where
219214 , termWidthMaps = termWidthMaps c1 <|> termWidthMaps c0
220215 , allowCustomUnicodeWidthTables =
221216 allowCustomUnicodeWidthTables c1 <|> allowCustomUnicodeWidthTables c0
222− , colorMode = colorMode c1 <|> colorMode c0
223217 }
224218
225219instance Monoid Config where
@@ -235,7 +229,6 @@ instance Monoid Config where
235229 , termName = Nothing
236230 , termWidthMaps = []
237231 , allowCustomUnicodeWidthTables = Nothing
238− , colorMode = Nothing
239232 }
240233#if !(MIN_VERSION_base(4,11,0))
241234 mappend = (<>)
@@ -291,8 +284,7 @@ standardIOConfig = do
291284 mb <- lookupEnv termVariable
292285 case mb of
293286 Nothing -> throwIO VtyMissingTermEnvVar
294− Just t -> do
295− mcolorMode <- detectColorMode t
287+ Just t ->
296288 return defaultConfig
297289 { vmin = Just 1
298290 , mouseMode = Just False
@@ -301,7 +293,6 @@ standardIOConfig = do
301293 , inputFd = Just stdInput
302294 , outputFd = Just stdOutput
303295 , termName = Just t
304− , colorMode = Just mcolorMode
305296 }
306297
307298parseConfigFile :: FilePath -> IO Config
src/Graphics/Vty/DisplayAttributes.hs−3
@@ -96,8 +96,6 @@ data StyleStateChange
9696 | RemoveStandout
9797 | ApplyItalic
9898 | RemoveItalic
99− | ApplyStrikethrough
100− | RemoveStrikethrough
10199 | ApplyUnderline
102100 | RemoveUnderline
103101 | ApplyReverseVideo
@@ -146,7 +144,6 @@ diffStyles prev cur
146144 [ styleDiff standout ApplyStandout RemoveStandout
147145 , styleDiff underline ApplyUnderline RemoveUnderline
148146 , styleDiff italic ApplyItalic RemoveItalic
149− , styleDiff strikethrough ApplyStrikethrough RemoveStrikethrough
150147 , styleDiff reverseVideo ApplyReverseVideo RemoveReverseVideo
151148 , styleDiff blink ApplyBlink RemoveBlink
152149 , styleDiff dim ApplyDim RemoveDim
src/Graphics/Vty/Image.hs+2−1
@@ -1,4 +1,5 @@
11-- Copyright 2009-2010 Corey O'Connor
2+{-# LANGUAGE BangPatterns #-}
23{-# LANGUAGE NamedFieldPuns #-}
34{-# LANGUAGE DisambiguateRecordFields #-}
45-- | A Vty program makes 'Picture's from 'Image's. This module provides
@@ -137,7 +138,7 @@ char a c =
137138 let displayWidth = safeWcwidth c
138139 in HorizText a (TL.singleton c) displayWidth 1
139140
140−-- | Make an image from a string of characters laid out on a single
141+-- | Make an image from a string of characters layed out on a single
141142-- row with the same display attribute. The string is assumed to be a
142143-- sequence of ISO-10646 characters. The input string should be
143144-- sanitized of escape sequences (ASCII 27) and carriage returns;
src/Graphics/Vty/Image/Internal.hs+3−3
@@ -146,7 +146,7 @@ data Image =
146146
147147-- | pretty print just the structure of an image.
148148ppImageStructure :: Image -> String
149−ppImageStructure = go 0
149+ppImageStructure inImg = go 0 inImg
150150 where
151151 go indent img = tab indent ++ pp indent img
152152 tab indent = concat $ replicate indent " "
@@ -228,7 +228,7 @@ instance Monoid Image where
228228--
229229-- The result image will have a width equal to the sum of the two images
230230-- 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
232232-- will be filled with the background pattern.
233233horizJoin :: Image -> Image -> Image
234234horizJoin EmptyImage i = i
@@ -259,7 +259,7 @@ horizJoin _ _ = error "horizJoin applied to undefined values."
259259--
260260-- The result image will have a height equal to the sum of the heights
261261-- 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
263263-- will be filled with the background pattern.
264264vertJoin :: Image -> Image -> Image
265265vertJoin EmptyImage i = i
src/Graphics/Vty/Inline.hs+7−5
@@ -1,3 +1,5 @@
1+{-# LANGUAGE BangPatterns #-}
2+
13-- | The inline module provides a limited interface to changing the
24-- style of terminal output. The intention is for this interface to be
35-- used inline with other output systems.
@@ -56,13 +58,13 @@ data InlineState =
5658-- | Set the background color to the provided 'Color'.
5759backColor :: Color -> InlineM ()
5860backColor c = modify $ \s ->
59− s { inlineAttr = inlineAttr s `withBackColor` c
61+ s { inlineAttr = inlineAttr s `mappend` (currentAttr `withBackColor` c)
6062 }
6163
6264-- | Set the foreground color to the provided 'Color'.
6365foreColor :: Color -> InlineM ()
6466foreColor c = modify $ \s ->
65− s { inlineAttr = inlineAttr s `withForeColor` c
67+ s { inlineAttr = inlineAttr s `mappend` (currentAttr `withForeColor` c)
6668 }
6769
6870-- | Attempt to change the 'Style' of the following text..
@@ -71,7 +73,7 @@ foreColor c = modify $ \s ->
7173-- produced. The style can still be removed.
7274applyStyle :: Style -> InlineM ()
7375applyStyle st = modify $ \s ->
74− s { inlineAttr = inlineAttr s `withStyle` st
76+ s { inlineAttr = inlineAttr s `mappend` (currentAttr `withStyle` st)
7577 }
7678
7779-- | Attempt to remove the specified 'Style' from the display of the
@@ -83,8 +85,8 @@ removeStyle :: Style -> InlineM ()
8385removeStyle sMask = modify $ \s ->
8486 s { inlineAttr =
8587 let style' = case attrStyle (inlineAttr s) of
86− Default -> error "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."
87− KeepCurrent -> error "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."
88+ Default -> error $ "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."
89+ KeepCurrent -> error $ "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."
8890 SetTo st -> st .&. complement sMask
8991 in (inlineAttr s) { attrStyle = SetTo style' }
9092 }
src/Graphics/Vty/Input.hs+4−3
@@ -77,7 +77,7 @@
7777-- The input encoding determines how UTF-8 encoded characters are
7878-- recognized.
7979--
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
8181-- a superset of ASCII. UTF-8 does not overlap escaped control key
8282-- sequences. However, the escape key must be differentiated from
8383-- escaped control key sequences by the timing of the input bytes.
@@ -95,7 +95,7 @@
9595--
9696-- == Terminal Input is Broken
9797--
98−-- Clearly terminal input has fundamental issues. There is no easy way
98+-- Clearly terminal input has fundemental issues. There is no easy way
9999-- to reliably resolve these issues.
100100--
101101-- One resolution would be to ditch standard terminal interfaces
@@ -158,8 +158,9 @@ inputForConfig config@Config{ termName = Just termName
158158 setAttrs
159159 input <- initInput config activeInputMap
160160 let pokeIO = Catch $ do
161+ let e = error "vty internal failure: this value should not propagate to users"
161162 setAttrs
162− atomically $ writeTChan (input^.eventChannel) ResumeAfterSignal
163+ atomically $ writeTChan (input^.eventChannel) (EvResize e e)
163164 _ <- installHandler windowChange pokeIO Nothing
164165 _ <- installHandler continueProcess pokeIO Nothing
165166
src/Graphics/Vty/Input/Classify.hs+29−53
@@ -1,11 +1,10 @@
11{-# OPTIONS_HADDOCK hide #-}
2−-- This makes a kind of trie. Has space efficiency issues with large
2+-- This makes a kind of tri. Has space efficiency issues with large
33-- input blocks. Likely building a parser and just applying that would
44-- be better.
55module Graphics.Vty.Input.Classify
66 ( classify
77 , KClass(..)
8− , ClassifierState(..)
98 )
109where
1110
@@ -17,39 +16,25 @@ import Graphics.Vty.Input.Classify.Types
1716
1817import Codec.Binary.UTF8.Generic (decode)
1918
20−import Control.Arrow (first)
19+import Data.List (inits)
2120import qualified Data.Map as M( fromList, lookup )
2221import Data.Maybe ( mapMaybe )
2322import qualified Data.Set as S( fromList, member )
2423
24+import Data.Char
2525import Data.Word
2626
27−import qualified Data.ByteString as BS
28−import qualified Data.ByteString.Char8 as BS8
29−import Data.ByteString.Char8 (ByteString)
30−
31−-- | Whether the classifier is currently processing a chunked format.
32−-- Currently, only bracketed pastes use this.
33−data ClassifierState
34− = ClassifierStart
35− -- ^ Not processing a chunked format.
36− | ClassifierInChunk ByteString [ByteString]
37− -- ^ Currently processing a chunked format. The initial chunk is in the
38− -- first argument and a reversed remainder of the chunks is collected in
39− -- the second argument. At the end of the processing, the chunks are
40− -- reversed and concatenated with the final chunk.
41−
42−compile :: ClassifyMap -> ByteString -> KClass
27+compile :: ClassifyMap -> [Char] -> KClass
4328compile table = cl' where
4429 -- take all prefixes and create a set of these
45− prefixSet = S.fromList $ concatMap (init . BS.inits . BS8.pack . fst) table
30+ prefixSet = S.fromList $ concatMap (init . inits . fst) $ table
4631 maxValidInputLength = maximum (map (length . fst) table)
47− eventForInput = M.fromList $ map (first BS8.pack) table
48− cl' inputBlock | BS8.null inputBlock = Prefix
32+ eventForInput = M.fromList table
33+ cl' [] = Prefix
4934 cl' inputBlock = case M.lookup inputBlock eventForInput of
5035 -- if the inputBlock is exactly what is expected for an
5136 -- event then consume the whole block and return the event
52− Just e -> Valid e BS8.empty
37+ Just e -> Valid e []
5338 Nothing -> case S.member inputBlock prefixSet of
5439 True -> Prefix
5540 -- look up progressively smaller tails of the input
@@ -60,49 +45,40 @@ compile table = cl' where
6045 -- H: There will always be one match. The prefixSet
6146 -- contains, by definition, all prefixes of an event.
6247 False ->
63− let inputPrefixes = reverse . take maxValidInputLength . tail . BS8.inits $ inputBlock
48+ let inputPrefixes = reverse $ take maxValidInputLength $ tail $ inits inputBlock
6449 in case mapMaybe (\s -> (,) s `fmap` M.lookup s eventForInput) inputPrefixes of
65− (s,e) : _ -> Valid e (BS8.drop (BS8.length s) inputBlock)
50+ (s,e) : _ -> Valid e (drop (length s) inputBlock)
6651 -- neither a prefix or a full event.
6752 [] -> Invalid
6853
69−classify :: ClassifyMap -> ClassifierState -> ByteString -> KClass
70−classify table = process
71− where
72− standardClassifier = compile table
73−
74− process ClassifierStart s =
75− case BS.uncons s of
76− _ | bracketedPasteStarted s ->
77− if bracketedPasteFinished s
78− then parseBracketedPaste s
79− else Chunk
80− _ | isMouseEvent s -> classifyMouseEvent s
81− _ | isFocusEvent s -> classifyFocusEvent s
82− Just (c,cs) | c >= 0xC2 -> classifyUtf8 c cs
83− _ -> standardClassifier s
84−
85− process (ClassifierInChunk p ps) s | bracketedPasteStarted p =
54+classify :: ClassifyMap -> [Char] -> KClass
55+classify table =
56+ let standardClassifier = compile table
57+ in \s -> case s of
58+ _ | bracketedPasteStarted s ->
8659 if bracketedPasteFinished s
87− then parseBracketedPaste $ BS.concat $ p:reverse (s:ps)
88− else Chunk
89− process ClassifierInChunk{} _ = Invalid
60+ then parseBracketedPaste s
61+ else Prefix
62+ _ | isMouseEvent s -> classifyMouseEvent s
63+ _ | isFocusEvent s -> classifyFocusEvent s
64+ c:cs | ord c >= 0xC2 -> classifyUtf8 c cs
65+ _ -> standardClassifier s
9066
91−classifyUtf8 :: Word8 -> ByteString -> KClass
67+classifyUtf8 :: Char -> [Char] -> KClass
9268classifyUtf8 c cs =
93− let n = utf8Length c
94− (codepoint,rest) = BS8.splitAt (n - 1) cs
69+ let n = utf8Length (ord c)
70+ (codepoint,rest) = splitAt n (c:cs)
9571
9672 codepoint8 :: [Word8]
97− codepoint8 = c:BS.unpack codepoint
73+ codepoint8 = map (fromIntegral . ord) codepoint
9874
9975 in case decode codepoint8 of
100− _ | n < BS.length codepoint + 1 -> Prefix
101− Just (unicodeChar, _) -> Valid (EvKey (KChar unicodeChar) []) rest
76+ _ | n < length codepoint -> Prefix
77+ Just (unicodeChar, _) -> Valid (EvKey (KChar unicodeChar) []) rest
10278 -- something bad happened; just ignore and continue.
103− Nothing -> Invalid
79+ Nothing -> Invalid
10480
105−utf8Length :: Word8 -> Int
81+utf8Length :: (Num t, Ord a, Num a) => a -> t
10682utf8Length c
10783 | c < 0x80 = 1
10884 | c < 0xE0 = 2
src/Graphics/Vty/Input/Classify/Parse.hs+7−10
@@ -16,15 +16,12 @@ import Graphics.Vty.Input.Classify.Types
1616import Control.Monad.Trans.Maybe
1717import Control.Monad.State
1818
19−import qualified Data.ByteString.Char8 as BS8
20−import Data.ByteString.Char8 (ByteString)
21−
22−type Parser a = MaybeT (State ByteString) a
19+type Parser a = MaybeT (State String) a
2320
2421-- | Run a parser on a given input string. If the parser fails, return
2522-- 'Invalid'. Otherwise return the valid event ('Valid') and the
2623-- remaining unparsed characters.
27−runParser :: ByteString -> Parser Event -> KClass
24+runParser :: String -> Parser Event -> KClass
2825runParser s parser =
2926 case runState (runMaybeT parser) s of
3027 (Nothing, _) -> Invalid
@@ -39,9 +36,9 @@ failParse = fail "invalid parse"
3936-- return '123' and consume those characters.
4037readInt :: Parser Int
4138readInt = do
42− s <- BS8.unpack <$> get
39+ s <- get
4340 case (reads :: ReadS Int) s of
44− [(i, rest)] -> put (BS8.pack rest) >> return i
41+ [(i, rest)] -> put rest >> return i
4542 _ -> failParse
4643
4744-- | Read a character from the input stream. If one cannot be read (e.g.
@@ -49,9 +46,9 @@ readInt = do
4946readChar :: Parser Char
5047readChar = do
5148 s <- get
52− case BS8.uncons s of
53− Just (c,rest) -> put rest >> return c
54− Nothing -> failParse
49+ case s of
50+ c:rest -> put rest >> return c
51+ _ -> failParse
5552
5653-- | Read a character from the input stream and fail parsing if it is
5754-- not the specified character.
src/Graphics/Vty/Input/Classify/Types.hs+1−7
@@ -1,6 +1,5 @@
11-- | This module exports the input classification type to avoid import
22-- cycles between other modules that need this.
3−{-# LANGUAGE StrictData #-}
43module Graphics.Vty.Input.Classify.Types
54 ( KClass(..)
65 )
@@ -8,10 +7,8 @@ where
87
98import Graphics.Vty.Input.Events
109
11−import Data.ByteString.Char8 (ByteString)
12−
1310data KClass
14− = Valid Event ByteString
11+ = Valid Event [Char]
1512 -- ^ A valid event was parsed. Any unused characters from the input
1613 -- stream are also provided.
1714 | Invalid
@@ -19,7 +16,4 @@ data KClass
1916 | Prefix
2017 -- ^ The input characters form the prefix of a valid event character
2118 -- sequence.
22− | Chunk
23− -- ^ The input characters are either start of a bracketed paste chunk
24− -- or in the middle of a bracketed paste chunk.
2519 deriving(Show, Eq)
src/Graphics/Vty/Input/Events.hs+6−24
@@ -1,8 +1,6 @@
11{-# Language DeriveGeneric #-}
2−{-# Language StrictData #-}
32module Graphics.Vty.Input.Events where
43
5−import Control.DeepSeq
64import Data.ByteString
75import GHC.Generics
86
@@ -16,29 +14,23 @@ import GHC.Generics
1614--
1715-- * Actually, support for most of these but KEsc, KChar, KBS, and
1816-- KEnter vary by terminal and keyboard.
19−data Key = KEsc | KChar {-# UNPACK #-} Char | KBS | KEnter
17+data Key = KEsc | KChar Char | KBS | KEnter
2018 | KLeft | KRight | KUp | KDown
2119 | KUpLeft | KUpRight | KDownLeft | KDownRight | KCenter
22− | KFun {-# UNPACK #-} Int | KBackTab | KPrtScr | KPause | KIns
20+ | KFun Int | KBackTab | KPrtScr | KPause | KIns
2321 | KHome | KPageUp | KDel | KEnd | KPageDown | KBegin | KMenu
2422 deriving (Eq,Show,Read,Ord,Generic)
2523
26−instance NFData Key
27−
2824-- | Modifier keys. Key codes are interpreted such that users are more
2925-- likely to have Meta than Alt; for instance on the PC Linux console,
3026-- 'MMeta' will generally correspond to the physical Alt key.
3127data Modifier = MShift | MCtrl | MMeta | MAlt
3228 deriving (Eq,Show,Read,Ord,Generic)
3329
34−instance NFData Modifier
35−
3630-- | Mouse buttons.
3731data Button = BLeft | BMiddle | BRight | BScrollUp | BScrollDown
3832 deriving (Eq,Show,Read,Ord,Generic)
3933
40−instance NFData Button
41−
4234-- | Events.
4335data Event
4436 = EvKey Key [Modifier]
@@ -52,8 +44,10 @@ data Event
5244 -- without specifying which one; in that case, Nothing is provided.
5345 -- Otherwise Just the button released is included in the event.
5446 | EvResize Int Int
55− -- The terminal window was resized and the size is provided in the
56− -- integer fields (width, height).
47+ -- ^ If read from 'eventChannel' this is the size at the time of the
48+ -- signal. If read from 'nextEvent' this is the size at the time the
49+ -- event was processed by Vty. Typically these are the same, but if
50+ -- somebody is resizing the terminal quickly they can be different.
5751 | EvPaste ByteString
5852 -- ^ A paste event occurs when a bracketed paste input sequence is
5953 -- received. For terminals that support bracketed paste mode, these
@@ -68,16 +62,4 @@ data Event
6862 -- ^ The terminal running the application gained input focus.
6963 deriving (Eq,Show,Read,Ord,Generic)
7064
71−instance NFData Event
72−
7365type ClassifyMap = [(String,Event)]
74−
75−-- | The type of internal events that drive the internal Vty event
76−-- dispatching to the application.
77−data InternalEvent =
78− ResumeAfterSignal
79− -- ^ Vty resumed operation after the process was interrupted with a
80− -- signal. In practice this translates into a screen redraw in the
81− -- input event loop.
82− | InputEvent Event
83− -- ^ An input event was received.
src/Graphics/Vty/Input/Focus.hs+13−15
@@ -11,32 +11,30 @@ import Graphics.Vty.Input.Classify.Types
1111import Graphics.Vty.Input.Classify.Parse
1212
1313import Control.Monad.State
14−
15−import qualified Data.ByteString.Char8 as BS8
16−import Data.ByteString.Char8 (ByteString)
14+import Data.List (isPrefixOf)
1715
1816-- | These sequences set xterm-based terminals to send focus event
1917-- sequences.
20−requestFocusEvents :: ByteString
21−requestFocusEvents = BS8.pack "\ESC[?1004h"
18+requestFocusEvents :: String
19+requestFocusEvents = "\ESC[?1004h"
2220
2321-- | These sequences disable focus events.
24−disableFocusEvents :: ByteString
25−disableFocusEvents = BS8.pack "\ESC[?1004l"
22+disableFocusEvents :: String
23+disableFocusEvents = "\ESC[?1004l"
2624
2725-- | Does the specified string begin with a focus event?
28−isFocusEvent :: ByteString -> Bool
29−isFocusEvent s = BS8.isPrefixOf focusIn s ||
30− BS8.isPrefixOf focusOut s
26+isFocusEvent :: String -> Bool
27+isFocusEvent s = isPrefixOf focusIn s ||
28+ isPrefixOf focusOut s
3129
32−focusIn :: ByteString
33−focusIn = BS8.pack "\ESC[I"
30+focusIn :: String
31+focusIn = "\ESC[I"
3432
35−focusOut :: ByteString
36−focusOut = BS8.pack "\ESC[O"
33+focusOut :: String
34+focusOut = "\ESC[O"
3735
3836-- | Attempt to classify an input string as a focus event.
39−classifyFocusEvent :: ByteString -> KClass
37+classifyFocusEvent :: String -> KClass
4038classifyFocusEvent s = runParser s $ do
4139 when (not $ isFocusEvent s) failParse
4240
src/Graphics/Vty/Input/Loop.hs+23−42
@@ -1,9 +1,8 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE NoMonomorphismRestriction #-}
31{-# LANGUAGE RecordWildCards #-}
4−{-# LANGUAGE ScopedTypeVariables #-}
5−{-# LANGUAGE TemplateHaskell #-}
62{-# OPTIONS_HADDOCK hide #-}
3+{-# LANGUAGE NoMonomorphismRestriction #-}
4+{-# LANGUAGE TemplateHaskell #-}
5+{-# LANGUAGE CPP #-}
76-- | The input layer used to be a single function that correctly
87-- accounted for the non-threaded runtime by emulating the terminal
98-- VMIN adn VTIME handling. This has been removed and replace with a
@@ -34,15 +33,12 @@ import Control.Monad.Trans.State (StateT(..), evalStateT)
3433import Control.Monad.State.Class (MonadState, modify)
3534import Control.Monad.Trans.Reader (ReaderT(..))
3635
37−import qualified Data.ByteString.Char8 as BS8
38−import qualified Data.ByteString as BS
39−import Data.ByteString.Char8 (ByteString)
36+import Data.Char
4037import Data.IORef
4138import Data.Word (Word8)
4239
43−import Foreign (allocaArray)
40+import Foreign ( allocaArray, peekArray, Ptr )
4441import Foreign.C.Types (CInt(..))
45−import Foreign.Ptr (Ptr, castPtr)
4642
4743import System.IO
4844import System.Posix.IO (fdReadBuf, setFdOption, FdOption(..))
@@ -55,7 +51,7 @@ data Input = Input
5551 { -- | Channel of events direct from input processing. Unlike
5652 -- 'nextEvent' this will not refresh the display if the next event
5753 -- is an 'EvResize'.
58− _eventChannel :: TChan InternalEvent
54+ _eventChannel :: TChan Event
5955 -- | Shuts down the input processing. As part of shutting down the
6056 -- input, this should also restore the input state.
6157 , shutdownInput :: IO ()
@@ -80,11 +76,10 @@ data InputBuffer = InputBuffer
8076makeLenses ''InputBuffer
8177
8278data InputState = InputState
83− { _unprocessedBytes :: ByteString
84− , _classifierState :: ClassifierState
79+ { _unprocessedBytes :: String
8580 , _appliedConfig :: Config
8681 , _inputBuffer :: InputBuffer
87− , _classifier :: ClassifierState -> ByteString -> KClass
82+ , _classifier :: String -> KClass
8883 }
8984
9085makeLenses ''InputState
@@ -109,20 +104,20 @@ loopInputProcessor = do
109104 dropInvalid
110105 loopInputProcessor
111106
112−addBytesToProcess :: ByteString -> InputM ()
107+addBytesToProcess :: String -> InputM ()
113108addBytesToProcess block = unprocessedBytes <>= block
114109
115110emit :: Event -> InputM ()
116111emit event = do
117112 logMsg $ "parsed event: " ++ show event
118− view eventChannel >>= liftIO . atomically . flip writeTChan (InputEvent event)
113+ view eventChannel >>= liftIO . atomically . flip writeTChan event
119114
120115-- The timing requirements are assured by the VMIN and VTIME set for the
121116-- device.
122117--
123118-- Precondition: Under the threaded runtime. Only current use is from a
124119-- forkOS thread. That case satisfies precondition.
125−readFromDevice :: InputM ByteString
120+readFromDevice :: InputM String
126121readFromDevice = do
127122 newConfig <- view configRef >>= liftIO . readIORef
128123 oldConfig <- use appliedConfig
@@ -142,10 +137,9 @@ readFromDevice = do
142137 threadWaitRead fd
143138 bytesRead <- fdReadBuf fd bufferPtr (fromIntegral maxBytes)
144139 if bytesRead > 0
145− then BS.packCStringLen (castPtr bufferPtr, fromIntegral bytesRead)
146− else return BS.empty
147− when (not $ BS.null stringRep) $
148− logMsg $ "input bytes: " ++ show (BS8.unpack stringRep)
140+ then fmap (map $ chr . fromIntegral) $ peekArray (fromIntegral bytesRead) bufferPtr
141+ else return []
142+ when (not $ null stringRep) $ logMsg $ "input bytes: " ++ show stringRep
149143 return stringRep
150144
151145applyConfig :: Fd -> Config -> IO ()
@@ -156,43 +150,30 @@ applyConfig _ _ = fail "(vty) applyConfig was not provided a complete configurat
156150parseEvent :: InputM Event
157151parseEvent = do
158152 c <- use classifier
159− s <- use classifierState
160153 b <- use unprocessedBytes
161− case c s b of
154+ case c b of
162155 Valid e remaining -> do
163156 logMsg $ "valid parse: " ++ show e
164157 logMsg $ "remaining: " ++ show remaining
165− classifierState .= ClassifierStart
166158 unprocessedBytes .= remaining
167159 return e
168− _ -> mzero
160+ _ -> mzero
169161
170162dropInvalid :: InputM ()
171163dropInvalid = do
172164 c <- use classifier
173− s <- use classifierState
174165 b <- use unprocessedBytes
175− case c s b of
176− Chunk -> do
177− classifierState .=
178− case s of
179− ClassifierStart -> ClassifierInChunk b []
180− ClassifierInChunk p bs -> ClassifierInChunk p (b:bs)
181− unprocessedBytes .= BS8.empty
182− Invalid -> do
183− logMsg "dropping input bytes"
184− classifierState .= ClassifierStart
185− unprocessedBytes .= BS8.empty
186− _ -> return ()
166+ when (c b == Invalid) $ do
167+ logMsg "dropping input bytes"
168+ unprocessedBytes .= []
187169
188170runInputProcessorLoop :: ClassifyMap -> Input -> IO ()
189171runInputProcessorLoop classifyTable input = do
190172 let bufferSize = 1024
191173 allocaArray bufferSize $ \(bufferPtr :: Ptr Word8) -> do
192− s0 <- InputState BS8.empty ClassifierStart
193− <$> readIORef (_configRef input)
194− <*> pure (InputBuffer bufferPtr bufferSize)
195− <*> pure (classify classifyTable)
174+ s0 <- InputState [] <$> readIORef (_configRef input)
175+ <*> pure (InputBuffer bufferPtr bufferSize)
176+ <*> pure (classify classifyTable)
196177 runReaderT (evalStateT loopInputProcessor s0) input
197178
198179-- | Construct two IO actions: one to configure the terminal for Vty and
@@ -243,7 +224,7 @@ logInitialInputState input classifyTable = case _inputDebug input of
243224 Just h -> do
244225 Config{ vmin = Just theVmin
245226 , vtime = Just theVtime
246− , termName = Just theTerm } <- readIORef $ _configRef input
227+ , termName = Just theTerm, .. } <- readIORef $ _configRef input
247228 _ <- hPrintf h "initial (vmin,vtime): %s\n" (show (theVmin, theVtime))
248229 forM_ classifyTable $ \i -> case i of
249230 (inBytes, EvKey k mods) -> hPrintf h "map %s %s %s %s\n" (show theTerm)
src/Graphics/Vty/Input/Mouse.hs+17−19
@@ -15,12 +15,10 @@ import Graphics.Vty.Input.Classify.Types
1515import Graphics.Vty.Input.Classify.Parse
1616
1717import Control.Monad.State
18+import Data.List (isPrefixOf)
1819import Data.Maybe (catMaybes)
1920import Data.Bits ((.&.))
2021
21−import qualified Data.ByteString.Char8 as BS8
22−import Data.ByteString.Char8 (ByteString)
23−
2422-- A mouse event in SGR extended mode is
2523--
2624-- '\ESC' '[' '<' B ';' X ';' Y ';' ('M'|'m')
@@ -34,28 +32,28 @@ import Data.ByteString.Char8 (ByteString)
3432
3533-- | These sequences set xterm-based terminals to send mouse event
3634-- sequences.
37−requestMouseEvents :: ByteString
38−requestMouseEvents = BS8.pack "\ESC[?1000h\ESC[?1002h\ESC[?1006h"
35+requestMouseEvents :: String
36+requestMouseEvents = "\ESC[?1000h\ESC[?1002h\ESC[?1006h"
3937
4038-- | These sequences disable mouse events.
41−disableMouseEvents :: ByteString
42−disableMouseEvents = BS8.pack "\ESC[?1000l\ESC[?1002l\ESC[?1006l"
39+disableMouseEvents :: String
40+disableMouseEvents = "\ESC[?1000l\ESC[?1002l\ESC[?1006l"
4341
4442-- | Does the specified string begin with a mouse event?
45−isMouseEvent :: ByteString -> Bool
43+isMouseEvent :: String -> Bool
4644isMouseEvent s = isSGREvent s || isNormalEvent s
4745
48−isSGREvent :: ByteString -> Bool
49−isSGREvent = BS8.isPrefixOf sgrPrefix
46+isSGREvent :: String -> Bool
47+isSGREvent = isPrefixOf sgrPrefix
5048
51−sgrPrefix :: ByteString
52−sgrPrefix = BS8.pack "\ESC[M"
49+sgrPrefix :: String
50+sgrPrefix = "\ESC[M"
5351
54−isNormalEvent :: ByteString -> Bool
55−isNormalEvent = BS8.isPrefixOf normalPrefix
52+isNormalEvent :: String -> Bool
53+isNormalEvent = isPrefixOf normalPrefix
5654
57−normalPrefix :: ByteString
58−normalPrefix = BS8.pack "\ESC[<"
55+normalPrefix :: String
56+normalPrefix = "\ESC[<"
5957
6058-- Modifier bits:
6159shiftBit :: Int
@@ -89,8 +87,8 @@ scrollDown = 65
8987hasBitSet :: Int -> Int -> Bool
9088hasBitSet val bit = val .&. bit > 0
9189
92−-- | Attempt to classify an input string as a mouse event.
93−classifyMouseEvent :: ByteString -> KClass
90+-- | Attempt to lassify an input string as a mouse event.
91+classifyMouseEvent :: String -> KClass
9492classifyMouseEvent s = runParser s $ do
9593 when (not $ isMouseEvent s) failParse
9694
@@ -102,7 +100,7 @@ classifyMouseEvent s = runParser s $ do
102100 'M' -> classifyNormalMouseEvent
103101 _ -> failParse
104102
105−-- Given a modifier/button value, determine which button was indicated
103+-- Given a modifer/button value, determine which button was indicated
106104getSGRButton :: Int -> Parser Button
107105getSGRButton mods =
108106 let buttonMap = [ (leftButton, BLeft)
src/Graphics/Vty/Input/Paste.hs+24−16
@@ -9,33 +9,41 @@ module Graphics.Vty.Input.Paste
99where
1010
1111import qualified Data.ByteString.Char8 as BS8
12−import Data.ByteString.Char8 (ByteString)
1312
1413import Graphics.Vty.Input.Events
1514import Graphics.Vty.Input.Classify.Types
1615
17−bracketedPasteStart :: ByteString
18−bracketedPasteStart = BS8.pack "\ESC[200~"
16+import Data.List (isPrefixOf, isInfixOf)
1917
20−bracketedPasteEnd :: ByteString
21−bracketedPasteEnd = BS8.pack "\ESC[201~"
18+bracketedPasteStart :: String
19+bracketedPasteStart = "\ESC[200~"
20+
21+bracketedPasteEnd :: String
22+bracketedPasteEnd = "\ESC[201~"
2223
2324-- | Does the input start a bracketed paste?
24−bracketedPasteStarted :: ByteString -> Bool
25−bracketedPasteStarted = BS8.isPrefixOf bracketedPasteStart
25+bracketedPasteStarted :: String -> Bool
26+bracketedPasteStarted = isPrefixOf bracketedPasteStart
2627
2728-- | Does the input contain a complete bracketed paste?
28−bracketedPasteFinished :: ByteString -> Bool
29−bracketedPasteFinished = BS8.isInfixOf bracketedPasteEnd
29+bracketedPasteFinished :: String -> Bool
30+bracketedPasteFinished = isInfixOf bracketedPasteEnd
3031
3132-- | Parse a bracketed paste. This should only be called on a string if
3233-- both 'bracketedPasteStarted' and 'bracketedPasteFinished' return
3334-- 'True'.
34−parseBracketedPaste :: ByteString -> KClass
35+parseBracketedPaste :: String -> KClass
3536parseBracketedPaste s =
36− Valid (EvPaste p) (BS8.drop endLen rest')
37− where
38− startLen = BS8.length bracketedPasteStart
39− endLen = BS8.length bracketedPasteEnd
40− (_, rest ) = BS8.breakSubstring bracketedPasteStart s
41− (p, rest') = BS8.breakSubstring bracketedPasteEnd . BS8.drop startLen $ rest
37+ let (p, rest) = takeUntil (drop (length bracketedPasteStart) s) bracketedPasteEnd
38+ rest' = if bracketedPasteEnd `isPrefixOf` rest
39+ then drop (length bracketedPasteEnd) rest
40+ else rest
41+ in Valid (EvPaste $ BS8.pack p) rest'
42+
43+takeUntil :: (Eq a) => [a] -> [a] -> ([a],[a])
44+takeUntil [] _ = ([], [])
45+takeUntil cs sub
46+ | length cs < length sub = (cs, [])
47+ | take (length sub) cs == sub = ([], drop (length sub) cs)
48+ | otherwise = let (pre, suf) = takeUntil (tail cs) sub
49+ in (head cs:pre, suf)
src/Graphics/Vty/Input/Terminfo.hs+4−6
@@ -74,7 +74,7 @@ visibleChars = [ ([x], EvKey (KChar x) [])
7474ctrlChars :: ClassifyMap
7575ctrlChars =
7676 [ ([toEnum x],EvKey (KChar y) [MCtrl])
77− | (x,y) <- zip [0..31] ('@':['a'..'z']++['['..'_'])
77+ | (x,y) <- zip ([0..31]) ('@':['a'..'z']++['['..'_'])
7878 , y /= 'i' -- Resolve issue #3 where CTRL-i hides TAB.
7979 , y /= 'h' -- CTRL-h should not hide BS
8080 ]
@@ -86,12 +86,10 @@ ctrlMetaChars = map (\(s,EvKey c m) -> ('\ESC':s, EvKey c (MMeta:m))) ctrlChars
8686-- | Esc, meta-esc, delete, meta-delete, enter, meta-enter.
8787specialSupportKeys :: ClassifyMap
8888specialSupportKeys =
89− [ ("\ESC\ESC[5~",EvKey KPageUp [MMeta])
90− , ("\ESC\ESC[6~",EvKey KPageDown [MMeta])
91− -- special support for ESC
92− , ("\ESC",EvKey KEsc []), ("\ESC\ESC",EvKey KEsc [MMeta])
89+ [ -- special support for ESC
90+ ("\ESC",EvKey KEsc []), ("\ESC\ESC",EvKey KEsc [MMeta])
9391 -- Special support for backspace
94− , ("\DEL",EvKey KBS []), ("\ESC\DEL",EvKey KBS [MMeta]), ("\b",EvKey KBS [])
92+ , ("\DEL",EvKey KBS []), ("\ESC\DEL",EvKey KBS [MMeta])
9593 -- Special support for Enter
9694 , ("\ESC\^J",EvKey KEnter [MMeta]), ("\^J",EvKey KEnter [])
9795 -- explicit support for tab
src/Graphics/Vty/Input/Terminfo/ANSIVT.hs+1−1
@@ -59,7 +59,7 @@ navKeys3 =
5959-- This encoding depends on the terminal.
6060functionKeys1 :: ClassifyMap
6161functionKeys1 =
62− let f ff nrs m = [ ("\ESC["++show n++"~",EvKey (KFun $ n-head nrs+ff) m) | n <- nrs ] in
62+ let f ff nrs m = [ ("\ESC["++show n++"~",EvKey (KFun $ n-(nrs!!0)+ff) m) | n <- nrs ] in
6363 concat [f 1 [25,26] [MShift], f 3 [28,29] [MShift], f 5 [31..34] [MShift] ]
6464
6565-- | encoding for meta plus char
src/Graphics/Vty/Output.hs+5−6
@@ -1,4 +1,4 @@
1−{-# LANGUAGE RecordWildCards, CPP #-}
1+{-# LANGUAGE RecordWildCards, NamedFieldPuns, CPP #-}
22-- | This module provides functions for accessing the current terminal
33-- or a specific terminal device.
44--
@@ -58,12 +58,11 @@ import Data.Monoid ((<>))
5858-- * If TERM contains "xterm" or "screen", use XTermColor.
5959-- * otherwise use the TerminfoBased driver.
6060outputForConfig :: Config -> IO Output
61−outputForConfig Config{ outputFd = Just fd, termName = Just termName
62− , colorMode = Just colorMode, .. } = do
61+outputForConfig Config{ outputFd = Just fd, termName = Just termName, .. } = do
6362 t <- if "xterm" `isPrefixOf` termName || "screen" `isPrefixOf` termName
64− then XTermColor.reserveTerminal termName fd colorMode
63+ then XTermColor.reserveTerminal termName fd
6564 -- Not an xterm-like terminal. try for generic terminfo.
66− else TerminfoBased.reserveTerminal termName fd colorMode
65+ else TerminfoBased.reserveTerminal termName fd
6766
6867 case mouseMode of
6968 Just s -> setMode t Mouse s
@@ -78,7 +77,7 @@ outputForConfig config = (<> config) <$> standardIOConfig >>= outputForConfig
7877
7978-- | Sets the cursor position to the given output column and row.
8079--
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
8281-- same coordinates. Characters can be a variable number of columns in
8382-- width.
8483--
src/Graphics/Vty/Output/Interface.hs+18−45
@@ -1,9 +1,9 @@
11-- Copyright Corey O'Connor
2+{-# LANGUAGE BangPatterns #-}
23{-# LANGUAGE RankNTypes #-}
34{-# LANGUAGE ExistentialQuantification #-}
45{-# LANGUAGE GADTs #-}
56{-# LANGUAGE FlexibleContexts #-}
6−{-# LANGUAGE ScopedTypeVariables #-}
77-- | This module provides an abstract interface for performing terminal
88-- output. The only user-facing part of this API is 'Output'.
99module Graphics.Vty.Output.Interface
@@ -79,6 +79,9 @@ data Output = Output
7979 , displayBounds :: IO DisplayRegion
8080 -- | Output the bytestring to the terminal device.
8181 , outputByteBuffer :: BS.ByteString -> IO ()
82+ -- | Specifies the maximum number of colors supported by the
83+ -- context.
84+ , contextColorCount :: Int
8285 -- | Specifies whether the cursor can be shown / hidden.
8386 , supportsCursorVisibility :: Bool
8487 -- | Indicates support for terminal modes for this output device.
@@ -98,24 +101,6 @@ data Output = Output
98101 , ringTerminalBell :: IO ()
99102 -- | Returns whether the terminal has an audio bell feature.
100103 , supportsBell :: IO Bool
101− -- | Returns whether the terminal supports italicized text.
102− --
103− -- This is terminal-dependent and should make a best effort to
104− -- determine whether this feature is supported, but even if the
105− -- terminal advertises support (e.g. via terminfo) that might not
106− -- be a reliable indicator of whether the feature will work as
107− -- desired.
108− , supportsItalics :: IO Bool
109− -- | Returns whether the terminal supports strikethrough text.
110− --
111− -- This is terminal-dependent and should make a best effort to
112− -- determine whether this feature is supported, but even if the
113− -- terminal advertises support (e.g. via terminfo) that might not
114− -- be a reliable indicator of whether the feature will work as
115− -- desired.
116− , supportsStrikethrough :: IO Bool
117− -- | Returns how many colors the terminal supports.
118− , outputColorMode :: ColorMode
119104 }
120105
121106displayContext :: Output -> DisplayRegion -> IO DisplayContext
@@ -206,12 +191,6 @@ outputPicture dc pic = do
206191 AbsoluteCursor x y ->
207192 writeShowCursor dc `mappend`
208193 writeMoveCursor dc (clampX x) (clampY y)
209− PositionOnly isAbs x y ->
210− if isAbs
211− then writeMoveCursor dc (clampX x) (clampY y)
212− else let (ox, oy) = charToOutputPos m (clampX x, clampY y)
213− m = cursorOutputMap ops $ picCursor pic
214− in writeMoveCursor dc (clampX ox) (clampY oy)
215194 Cursor x y ->
216195 let m = cursorOutputMap ops $ picCursor pic
217196 (ox, oy) = charToOutputPos m (clampX x, clampY y)
@@ -309,23 +288,17 @@ limitAttrForDisplay t attr
309288 where
310289 clampColor Default = Default
311290 clampColor KeepCurrent = KeepCurrent
312− clampColor (SetTo c) = clampColor' (outputColorMode t) c
313−
314− clampColor' NoColor _ = Default
315−
316− clampColor' ColorMode8 (ISOColor v)
317− | v >= 8 = SetTo $ ISOColor (v - 8)
318− | otherwise = SetTo $ ISOColor v
319− clampColor' ColorMode8 _ = Default
320−
321− clampColor' ColorMode16 c@(ISOColor _) = SetTo c
322− clampColor' ColorMode16 _ = Default
323−
324− clampColor' (ColorMode240 _) c@(ISOColor _) = SetTo c
325− clampColor' (ColorMode240 colorCount) c@(Color240 n)
326− | n <= colorCount = SetTo c
327− | otherwise = Default
328− clampColor' colorMode@(ColorMode240 _) (RGBColor r g b) =
329− clampColor' colorMode (color240 r g b)
330−
331− clampColor' FullColor c = SetTo c
291+ clampColor (SetTo c) = clampColor' c
292+ clampColor' (ISOColor v)
293+ | contextColorCount t < 8 = Default
294+ | contextColorCount t < 16 && v >= 8 = SetTo $ ISOColor (v - 8)
295+ | otherwise = SetTo $ ISOColor v
296+ clampColor' (Color240 v)
297+ -- Should we choose closest ISO color?
298+ | contextColorCount t < 8 = Default
299+ | contextColorCount t < 16 = Default
300+ | contextColorCount t <= 256 = SetTo $ Color240 v
301+ | otherwise
302+ = let p :: Double = fromIntegral v / 240.0
303+ v' = floor $ p * (fromIntegral $ contextColorCount t)
304+ in SetTo $ Color240 v'
src/Graphics/Vty/Output/Mock.hs+2−5
@@ -11,7 +11,6 @@ module Graphics.Vty.Output.Mock
1111where
1212
1313import Graphics.Vty.Image (DisplayRegion)
14−import Graphics.Vty.Attributes.Color (ColorMode(ColorMode16))
1514import Graphics.Vty.Output.Interface
1615
1716import Blaze.ByteString.Builder.Word (writeWord8)
@@ -31,7 +30,7 @@ type MockData = IORef (UTF8.UTF8 BS.ByteString)
3130-- without considering terminal specific issues.
3231--
3332-- 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
3534-- requirement of the produced representation is simplicity in parsing
3635-- the text representation and determining how the picture was mapped to
3736-- terminal operations.
@@ -49,19 +48,17 @@ mockTerminal r = liftIO $ do
4948 , releaseDisplay = return ()
5049 , ringTerminalBell = return ()
5150 , supportsBell = return False
52− , supportsItalics = return False
53− , supportsStrikethrough = return False
5451 , setDisplayBounds = const $ return ()
5552 , displayBounds = return r
5653 , outputByteBuffer = \bytes -> do
5754 putStrLn $ "mock outputByteBuffer of " ++ show (BS.length bytes) ++ " bytes"
5855 writeIORef outRef $ UTF8.fromRep bytes
56+ , contextColorCount = 16
5957 , supportsCursorVisibility = True
6058 , supportsMode = const False
6159 , setMode = const $ const $ return ()
6260 , getModeStatus = const $ return False
6361 , assumedStateRef = newAssumedStateRef
64− , outputColorMode = ColorMode16
6562 , mkDisplayContext = \tActual rActual -> return $ DisplayContext
6663 { contextRegion = rActual
6764 , contextDevice = tActual
src/Graphics/Vty/Output/TerminfoBased.hs+40−96
@@ -1,3 +1,4 @@
1+{-# LANGUAGE RecordWildCards #-}
12{-# LANGUAGE FlexibleInstances #-}
23{-# LANGUAGE OverloadedStrings #-}
34{-# LANGUAGE CPP #-}
@@ -14,7 +15,7 @@ module Graphics.Vty.Output.TerminfoBased
1415where
1516
1617import Control.Monad (when)
17−import Data.Bits (shiftL, (.&.))
18+import Data.Bits (shiftL)
1819import qualified Data.ByteString as BS
1920import Data.ByteString.Internal (toForeignPtr)
2021import Data.Terminfo.Parse
@@ -25,8 +26,9 @@ import Graphics.Vty.Image (DisplayRegion)
2526import Graphics.Vty.DisplayAttributes
2627import Graphics.Vty.Output.Interface
2728
28−import Blaze.ByteString.Builder (Write, writeToByteString, writeStorable, writeWord8)
29+import Blaze.ByteString.Builder (Write, writeToByteString, writeStorable)
2930
31+import Data.Bits ((.&.))
3032import Data.IORef
3133import Data.Maybe (isJust, isNothing, fromJust)
3234import Data.Word
@@ -49,6 +51,7 @@ data TerminfoCaps = TerminfoCaps
4951 , cup :: CapExpression
5052 , cnorm :: Maybe CapExpression
5153 , civis :: Maybe CapExpression
54+ , supportsNoColors :: Bool
5255 , useAltColorMap :: Bool
5356 , setForeColor :: CapExpression
5457 , setBackColor :: CapExpression
@@ -65,8 +68,6 @@ data DisplayAttrCaps = DisplayAttrCaps
6568 , exitStandout :: Maybe CapExpression
6669 , enterItalic :: Maybe CapExpression
6770 , exitItalic :: Maybe CapExpression
68− , enterStrikethrough :: Maybe CapExpression
69− , exitStrikethrough :: Maybe CapExpression
7071 , enterUnderline :: Maybe CapExpression
7172 , exitUnderline :: Maybe CapExpression
7273 , enterReverseVideo :: Maybe CapExpression
@@ -103,28 +104,28 @@ sendCapToTerminal t cap capParams = do
103104--
104105-- * Providing independent string capabilities for all display
105106-- attributes.
106−reserveTerminal :: String -> Fd -> ColorMode -> IO Output
107−reserveTerminal termName outFd colorMode = do
107+reserveTerminal :: String -> Fd -> IO Output
108+reserveTerminal termName outFd = do
108109 ti <- Terminfo.setupTerm termName
109110 -- assumes set foreground always implies set background exists.
110111 -- if set foreground is not set then all color changing style
111112 -- attributes are filtered.
112113 msetaf <- probeCap ti "setaf"
113114 msetf <- probeCap ti "setf"
114− let (useAlt, setForeCap)
115+ let (noColors, useAlt, setForeCap)
115116 = case msetaf of
116− Just setaf -> (False, setaf)
117+ Just setaf -> (False, False, setaf)
117118 Nothing -> case msetf of
118− Just setf -> (True, setf)
119− Nothing -> (True, error $ "no fore color support for terminal " ++ termName)
119+ Just setf -> (False, True, setf)
120+ Nothing -> (True, True, error $ "no fore color support for terminal " ++ termName)
120121 msetab <- probeCap ti "setab"
121122 msetb <- probeCap ti "setb"
122− let setBackCap
123+ let set_back_cap
123124 = case msetab of
124− Just setab -> setab
125125 Nothing -> case msetb of
126126 Just setb -> setb
127127 Nothing -> error $ "no back color support for terminal " ++ termName
128+ Just setab -> setab
128129
129130 hyperlinkModeStatus <- newIORef False
130131 newAssumedStateRef <- newIORef initialAssumedState
@@ -150,9 +151,10 @@ reserveTerminal termName outFd colorMode = do
150151 <*> requireCap ti "cup"
151152 <*> probeCap ti "cnorm"
152153 <*> probeCap ti "civis"
154+ <*> pure noColors
153155 <*> pure useAlt
154156 <*> pure setForeCap
155− <*> pure setBackCap
157+ <*> pure set_back_cap
156158 <*> requireCap ti "sgr0"
157159 <*> requireCap ti "clear"
158160 <*> requireCap ti "el"
@@ -164,10 +166,6 @@ reserveTerminal termName outFd colorMode = do
164166 sendCap setDefaultAttr []
165167 maybeSendCap cnorm []
166168 , supportsBell = return $ isJust $ ringBellAudio terminfoCaps
167− , supportsItalics = return $ (isJust $ enterItalic (displayAttrCaps terminfoCaps)) &&
168− (isJust $ exitItalic (displayAttrCaps terminfoCaps))
169− , supportsStrikethrough = return $ (isJust $ enterStrikethrough (displayAttrCaps terminfoCaps)) &&
170− (isJust $ exitStrikethrough (displayAttrCaps terminfoCaps))
171169 , ringTerminalBell = maybeSendCap ringBellAudio []
172170 , reserveDisplay = do
173171 -- If there is no support for smcup: Clear the screen
@@ -192,15 +190,20 @@ reserveTerminal termName outFd colorMode = do
192190 when (toEnum len /= actualLen) $ fail $ "Graphics.Vty.Output: outputByteBuffer "
193191 ++ "length mismatch. " ++ show len ++ " /= " ++ show actualLen
194192 ++ " Please report this bug to vty project."
193+ , contextColorCount
194+ = case supportsNoColors terminfoCaps of
195+ False -> case Terminfo.getCapability ti (Terminfo.tiGetNum "colors" ) of
196+ Nothing -> 8
197+ Just v -> toEnum v
198+ True -> 1
195199 , supportsCursorVisibility = isJust $ civis terminfoCaps
196200 , supportsMode = terminfoModeSupported
197201 , setMode = terminfoSetMode
198202 , getModeStatus = terminfoModeStatus
199203 , assumedStateRef = newAssumedStateRef
200− , outputColorMode = colorMode
201204 -- I think fix would help assure tActual is the only
202205 -- reference. I was having issues tho.
203− , mkDisplayContext = (`terminfoDisplayContext` terminfoCaps)
206+ , mkDisplayContext = \tActual -> terminfoDisplayContext tActual terminfoCaps
204207 }
205208 sendCap s = sendCapToTerminal t (s terminfoCaps)
206209 maybeSendCap s = when (isJust $ s terminfoCaps) . sendCap (fromJust . s)
@@ -232,8 +235,6 @@ currentDisplayAttrCaps ti
232235 <*> probeCap ti "rmso"
233236 <*> probeCap ti "sitm"
234237 <*> probeCap ti "ritm"
235− <*> probeCap ti "smxx"
236− <*> probeCap ti "rmxx"
237238 <*> probeCap ti "smul"
238239 <*> probeCap ti "rmul"
239240 <*> probeCap ti "rev"
@@ -269,11 +270,7 @@ terminfoDisplayContext tActual terminfoCaps r = return dc
269270 , writeSetAttr = terminfoWriteSetAttr dc terminfoCaps
270271 , writeDefaultAttr = \urlsEnabled ->
271272 writeCapExpr (setDefaultAttr terminfoCaps) [] `mappend`
272− (if urlsEnabled then writeURLEscapes EndLink else mempty) `mappend`
273− (case exitStrikethrough $ displayAttrCaps terminfoCaps of
274− Just cap -> writeCapExpr cap []
275− Nothing -> mempty
276− )
273+ (if urlsEnabled then writeURLEscapes EndLink else mempty)
277274 , writeRowEnd = writeCapExpr (clearEol terminfoCaps) []
278275 , inlineHack = return ()
279276 }
@@ -295,7 +292,7 @@ writeURLEscapes NoLinkChange =
295292-- | Portably setting the display attributes is a giant pain in the ass.
296293--
297294-- 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
295+-- state of each style directly ; and, for no good reason, resets the
299296-- colors to the default) this procedure is used:
300297--
301298-- 0. set the style attributes. This resets the fore and back color.
@@ -334,9 +331,9 @@ terminfoWriteSetAttr dc terminfoCaps urlsEnabled prevAttr reqAttr diffs =
334331 -- The only way to reset either color, portably, to the default
335332 -- is to use either the set state capability or the set default
336333 -- capability.
337− True -> do
334+ True -> do
338335 case reqDisplayCapSeqFor (displayAttrCaps terminfoCaps)
339− (fixedStyle attr)
336+ (fixedStyle attr )
340337 (styleToApplySeq $ fixedStyle attr) of
341338 -- only way to reset a color to the defaults
342339 EnterExitSeq caps -> writeDefaultAttr dc urlsEnabled
@@ -346,11 +343,11 @@ terminfoWriteSetAttr dc terminfoCaps urlsEnabled prevAttr reqAttr diffs =
346343 setColors
347344 -- implicitly resets the colors to the defaults
348345 SetState state -> writeCapExpr (fromJust $ setAttrStates
349− $ displayAttrCaps terminfoCaps
346+ $ displayAttrCaps
347+ $ terminfoCaps
350348 )
351349 (sgrArgsForState state)
352350 `mappend` setItalics
353− `mappend` setStrikethrough
354351 `mappend` setColors
355352 -- Otherwise the display colors are not changing or changing
356353 -- between two non-default points.
@@ -369,16 +366,15 @@ terminfoWriteSetAttr dc terminfoCaps urlsEnabled prevAttr reqAttr diffs =
369366 -- applied states.
370367 EnterExitSeq caps -> foldMap (\cap -> writeCapExpr cap []) caps
371368 `mappend`
372− writeColorDiff Foreground (foreColorDiff diffs)
369+ writeColorDiff setForeColor (foreColorDiff diffs)
373370 `mappend`
374− writeColorDiff Background (backColorDiff diffs)
371+ writeColorDiff setBackColor (backColorDiff diffs)
375372 -- implicitly resets the colors to the defaults
376373 SetState state -> writeCapExpr (fromJust $ setAttrStates
377374 $ displayAttrCaps terminfoCaps
378375 )
379376 (sgrArgsForState state)
380377 `mappend` setItalics
381− `mappend` setStrikethrough
382378 `mappend` setColors
383379 where
384380 urlAttrs True = writeURLEscapes (urlDiff diffs)
@@ -396,72 +392,31 @@ terminfoWriteSetAttr dc terminfoCaps urlsEnabled prevAttr reqAttr diffs =
396392 , Just sitm <- enterItalic (displayAttrCaps terminfoCaps)
397393 = writeCapExpr sitm []
398394 | otherwise = mempty
399− setStrikethrough
400− | hasStyle (fixedStyle attr) strikethrough
401− , Just smxx <- enterStrikethrough (displayAttrCaps terminfoCaps)
402− = writeCapExpr smxx []
403− | otherwise = mempty
404395 setColors =
405396 (case fixedForeColor attr of
406− Just c -> writeColor Foreground c
397+ Just c -> writeCapExpr (setForeColor terminfoCaps)
398+ [toEnum $ colorMap c]
407399 Nothing -> mempty)
408400 `mappend`
409401 (case fixedBackColor attr of
410− Just c -> writeColor Background c
402+ Just c -> writeCapExpr (setBackColor terminfoCaps)
403+ [toEnum $ colorMap c]
411404 Nothing -> mempty)
412− writeColorDiff _side NoColorChange
405+ writeColorDiff _f NoColorChange
413406 = mempty
414− writeColorDiff _side ColorToDefault
407+ writeColorDiff _f ColorToDefault
415408 = error "ColorToDefault is not a possible case for applyColorDiffs"
416− writeColorDiff side (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]
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"
409+ writeColorDiff f (SetColor c)
410+ = writeCapExpr (f terminfoCaps) [toEnum $ colorMap c]
452411
453412-- | The color table used by a terminal is a 16 color set followed by a
454413-- 240 color set that might not be supported by the terminal.
455414--
456−-- This takes a Color which clearly identifies which palette to use and
457−-- computes the index into the full 256 color palette.
415+-- This takes a Color which clearly identifies which pallete to use and
416+-- computes the index into the full 256 color pallete.
458417ansiColorIndex :: Color -> Int
459418ansiColorIndex (ISOColor v) = fromEnum v
460419ansiColorIndex (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− ]
465420
466421-- | For terminals without setaf/setab
467422--
@@ -478,10 +433,6 @@ altColorIndex (ISOColor 6) = 3
478433altColorIndex (ISOColor 7) = 7
479434altColorIndex (ISOColor v) = fromEnum v
480435altColorIndex (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− ]
485436
486437{- | The sequence of terminfo caps to apply a given style are determined
487438 - according to these rules.
@@ -509,7 +460,6 @@ data DisplayAttrState = DisplayAttrState
509460 { applyStandout :: Bool
510461 , applyUnderline :: Bool
511462 , applyItalic :: Bool
512− , applyStrikethrough :: Bool
513463 , applyReverseVideo :: Bool
514464 , applyBlink :: Bool
515465 , applyDim :: Bool
@@ -546,8 +496,6 @@ reqDisplayCapSeqFor caps s diffs
546496 -- set state cap then just use the set state cap.
547497 ( True, True ) -> SetState $ stateForStyle s
548498 where
549− noEnterExitCap ApplyStrikethrough = isNothing $ enterStrikethrough caps
550− noEnterExitCap RemoveStrikethrough = isNothing $ exitStrikethrough caps
551499 noEnterExitCap ApplyItalic = isNothing $ enterItalic caps
552500 noEnterExitCap RemoveItalic = isNothing $ exitItalic caps
553501 noEnterExitCap ApplyStandout = isNothing $ enterStandout caps
@@ -562,8 +510,6 @@ reqDisplayCapSeqFor caps s diffs
562510 noEnterExitCap RemoveDim = True
563511 noEnterExitCap ApplyBold = isNothing $ enterBoldMode caps
564512 noEnterExitCap RemoveBold = True
565− enterExitCap ApplyStrikethrough = fromJust $ enterStrikethrough caps
566− enterExitCap RemoveStrikethrough = fromJust $ exitStrikethrough caps
567513 enterExitCap ApplyItalic = fromJust $ enterItalic caps
568514 enterExitCap RemoveItalic = fromJust $ exitItalic caps
569515 enterExitCap ApplyStandout = fromJust $ enterStandout caps
@@ -580,7 +526,6 @@ stateForStyle s = DisplayAttrState
580526 { applyStandout = isStyleSet standout
581527 , applyUnderline = isStyleSet underline
582528 , applyItalic = isStyleSet italic
583− , applyStrikethrough = isStyleSet strikethrough
584529 , applyReverseVideo = isStyleSet reverseVideo
585530 , applyBlink = isStyleSet blink
586531 , applyDim = isStyleSet dim
@@ -593,7 +538,6 @@ styleToApplySeq s = concat
593538 [ applyIfRequired ApplyStandout standout
594539 , applyIfRequired ApplyUnderline underline
595540 , applyIfRequired ApplyItalic italic
596− , applyIfRequired ApplyStrikethrough strikethrough
597541 , applyIfRequired ApplyReverseVideo reverseVideo
598542 , applyIfRequired ApplyBlink blink
599543 , applyIfRequired ApplyDim dim
src/Graphics/Vty/Output/XTermColor.hs+15−27
@@ -10,23 +10,17 @@ where
1010import Graphics.Vty.Output.Interface
1111import Graphics.Vty.Input.Mouse
1212import Graphics.Vty.Input.Focus
13−import Graphics.Vty.Attributes.Color (ColorMode)
1413import qualified Graphics.Vty.Output.TerminfoBased as TerminfoBased
1514
1615import Blaze.ByteString.Builder (writeToByteString)
1716import Blaze.ByteString.Builder.Word (writeWord8)
1817
19−import qualified Data.ByteString.Char8 as BS8
20−import Data.ByteString.Char8 (ByteString)
21−import Foreign.Ptr (castPtr)
22−
2318import Control.Monad (void, when)
2419import Control.Monad.Trans
25−import Data.Char (toLower)
2620import Data.IORef
2721
28−import System.Posix.IO (fdWriteBuf)
29−import System.Posix.Types (ByteCount, Fd)
22+import System.Posix.IO (fdWrite)
23+import System.Posix.Types (Fd)
3024import System.Posix.Env (getEnv)
3125
3226import Data.List (isInfixOf)
@@ -36,15 +30,9 @@ import Data.Maybe (catMaybes)
3630import Data.Monoid ((<>))
3731#endif
3832
39−-- | Write a 'ByteString' to an 'Fd'.
40−fdWrite :: Fd -> ByteString -> IO ByteCount
41−fdWrite fd s =
42− BS8.useAsCStringLen s $ \(buf,len) -> do
43− fdWriteBuf fd (castPtr buf) (fromIntegral len)
44−
4533-- | Construct an Xterm output driver. Initialize the display to UTF-8.
46−reserveTerminal :: ( Applicative m, MonadIO m ) => String -> Fd -> ColorMode -> m Output
47−reserveTerminal variant outFd colorMode = liftIO $ do
34+reserveTerminal :: ( Applicative m, MonadIO m ) => String -> Fd -> m Output
35+reserveTerminal variant outFd = liftIO $ do
4836 let flushedPut = void . fdWrite outFd
4937 -- If the terminal variant is xterm-color use xterm instead since,
5038 -- more often than not, xterm-color is broken.
@@ -52,7 +40,7 @@ reserveTerminal variant outFd colorMode = liftIO $ do
5240
5341 utf8a <- utf8Active
5442 when (not utf8a) $ flushedPut setUtf8CharSet
55− t <- TerminfoBased.reserveTerminal variant' outFd colorMode
43+ t <- TerminfoBased.reserveTerminal variant' outFd
5644
5745 mouseModeStatus <- newIORef False
5846 focusModeStatus <- newIORef False
@@ -104,26 +92,26 @@ reserveTerminal variant outFd colorMode = liftIO $ do
10492utf8Active :: IO Bool
10593utf8Active = do
10694 let vars = ["LC_ALL", "LANG", "LC_CTYPE"]
107− results <- map (toLower <$>) . catMaybes <$> mapM getEnv vars
108− let matches = filter ("utf8" `isInfixOf`) results <>
109− filter ("utf-8" `isInfixOf`) results
95+ results <- catMaybes <$> mapM getEnv vars
96+ let matches = filter ("UTF8" `isInfixOf`) results <>
97+ filter ("UTF-8" `isInfixOf`) results
11098 return $ not $ null matches
11199
112100-- | Enable bracketed paste mode:
113101-- http://cirw.in/blog/bracketed-paste
114−enableBracketedPastes :: ByteString
115−enableBracketedPastes = BS8.pack "\ESC[?2004h"
102+enableBracketedPastes :: String
103+enableBracketedPastes = "\ESC[?2004h"
116104
117105-- | Disable bracketed paste mode:
118−disableBracketedPastes :: ByteString
119−disableBracketedPastes = BS8.pack "\ESC[?2004l"
106+disableBracketedPastes :: String
107+disableBracketedPastes = "\ESC[?2004l"
120108
121109-- | These sequences set xterm based terminals to UTF-8 output.
122110--
123111-- There is no known terminfo capability equivalent to this.
124−setUtf8CharSet, setDefaultCharSet :: ByteString
125−setUtf8CharSet = BS8.pack "\ESC%G"
126−setDefaultCharSet = BS8.pack "\ESC%@"
112+setUtf8CharSet, setDefaultCharSet :: String
113+setUtf8CharSet = "\ESC%G"
114+setDefaultCharSet = "\ESC%@"
127115
128116xtermInlineHack :: Output -> IO ()
129117xtermInlineHack t = do
src/Graphics/Vty/Picture.hs+1−8
@@ -1,3 +1,4 @@
1+{-# LANGUAGE BangPatterns #-}
12-- A 'Picture' is a background paired with a set of 'Image' layers. The
23-- 'Picture' data structure is representative of the final terminal
34-- view.
@@ -79,14 +80,6 @@ picForLayers is = Picture
7980data Cursor =
8081 -- | Hide the cursor
8182 NoCursor
82− -- | Set the terminal's cursor position without displaying a cursor
83− -- character. This is important for accessibility with screen
84− -- readers where a cursor position needs to be reported but we may
85− -- not want to show a block cursor in that location for cosmetic
86− -- reasons. The boolean argument indicates whether the positioning
87− -- should be absolute as with 'AbsoluteCursor' ('True') or logical
88− -- as with 'Cursor' ('False').
89− | PositionOnly !Bool !Int !Int
9083 -- | Show the cursor at the given logical column accounting for
9184 -- character width in the presence of multi-column characters.
9285 | Cursor !Int !Int
src/Graphics/Vty/PictureToSpans.hs+4−4
@@ -72,7 +72,7 @@ displayOpsForPic pic r = Vector.create (combinedOpsForLayers pic r)
7272-- | Returns the DisplayOps for an image rendered to a window the size
7373-- of the image.
7474--
75−-- largely used only for debugging.
75+-- largerly used only for debugging.
7676displayOpsForImage :: Image -> DisplayOps
7777displayOpsForImage i = displayOpsForPic (picForImage i) (imageWidth i, imageHeight i)
7878
@@ -81,7 +81,7 @@ combinedOpsForLayers :: Picture -> DisplayRegion -> ST s (MRowOps s)
8181combinedOpsForLayers pic r
8282 | regionWidth r == 0 || regionHeight r == 0 = MVector.new 0
8383 | otherwise = do
84− layerOps <- mapM (`buildSpans` r) (picLayers pic)
84+ layerOps <- mapM (\layer -> buildSpans layer r) (picLayers pic)
8585 case layerOps of
8686 [] -> fail "empty picture"
8787 [ops] -> substituteSkips (picBackground pic) ops
@@ -136,8 +136,8 @@ mergeUnder upper lower = do
136136 return upper
137137
138138mergeRowUnder :: SpanOps -> SpanOps -> SpanOps
139−mergeRowUnder upperRowOps =
140− onUpperOp Vector.empty (Vector.head upperRowOps) (Vector.tail upperRowOps)
139+mergeRowUnder upperRowOps lowerRowOps =
140+ onUpperOp Vector.empty (Vector.head upperRowOps) (Vector.tail upperRowOps) lowerRowOps
141141 where
142142 -- H: it will never be the case that we are out of upper ops
143143 -- before lower ops.
src/Graphics/Vty/Span.hs+4−2
@@ -1,4 +1,6 @@
11-- Copyright Corey O'Connor
2+{-# LANGUAGE BangPatterns #-}
3+{-# LANGUAGE NamedFieldPuns #-}
24{-# LANGUAGE GADTs #-}
35-- | A picture is translated into a sequences of state changes and
46-- character spans. The attribute is applied to all following spans,
@@ -50,7 +52,7 @@ dropOps :: Int -> SpanOps -> SpanOps
5052dropOps w = snd . splitOpsAt w
5153
5254splitOpsAt :: Int -> SpanOps -> (SpanOps, SpanOps)
53−splitOpsAt = splitOpsAt'
55+splitOpsAt inW inOps = splitOpsAt' inW inOps
5456 where
5557 splitOpsAt' 0 ops = (Vector.empty, ops)
5658 splitOpsAt' remainingColumns ops = case Vector.head ops of
@@ -101,7 +103,7 @@ displayOpsColumns ops
101103
102104-- | The number of rows the DisplayOps are defined for.
103105displayOpsRows :: DisplayOps -> Int
104−displayOpsRows = Vector.length
106+displayOpsRows ops = Vector.length ops
105107
106108affectedRegion :: DisplayOps -> DisplayRegion
107109affectedRegion ops = (displayOpsColumns ops, displayOpsRows ops)
test/VerifyColor240.hsdeleted−269
@@ -1,269 +0,0 @@
1−module VerifyColor240 where
2−
3−import Data.Word(Word8)
4−import Verify
5−
6−import Graphics.Vty.Attributes.Color240(rgbColorToColor240)
7−
8−oldRgbColorToColor240 :: Integral i => i -> i -> i -> Word8
9−oldRgbColorToColor240 r g b
10− | r < 0 && g < 0 && b < 0 = error "rgbColor with negative color component intensity"
11− | r == 8 && g == 8 && b == 8 = 216
12− | r == 18 && g == 18 && b == 18 = 217
13− | r == 28 && g == 28 && b == 28 = 218
14− | r == 38 && g == 38 && b == 38 = 219
15− | r == 48 && g == 48 && b == 48 = 220
16− | r == 58 && g == 58 && b == 58 = 221
17− | r == 68 && g == 68 && b == 68 = 222
18− | r == 78 && g == 78 && b == 78 = 223
19− | r == 88 && g == 88 && b == 88 = 224
20− | r == 98 && g == 98 && b == 98 = 225
21− | r == 108 && g == 108 && b == 108 = 226
22− | r == 118 && g == 118 && b == 118 = 227
23− | r == 128 && g == 128 && b == 128 = 228
24− | r == 138 && g == 138 && b == 138 = 229
25− | r == 148 && g == 148 && b == 148 = 230
26− | r == 158 && g == 158 && b == 158 = 231
27− | r == 168 && g == 168 && b == 168 = 232
28− | r == 178 && g == 178 && b == 178 = 233
29− | r == 188 && g == 188 && b == 188 = 234
30− | r == 198 && g == 198 && b == 198 = 235
31− | r == 208 && g == 208 && b == 208 = 236
32− | r == 218 && g == 218 && b == 218 = 237
33− | r == 228 && g == 228 && b == 228 = 238
34− | r == 238 && g == 238 && b == 238 = 239
35− | r <= 0 && g <= 0 && b <= 0 = 0
36− | r <= 0 && g <= 0 && b <= 95 = 1
37− | r <= 0 && g <= 0 && b <= 135 = 2
38− | r <= 0 && g <= 0 && b <= 175 = 3
39− | r <= 0 && g <= 0 && b <= 215 = 4
40− | r <= 0 && g <= 0 && b <= 255 = 5
41− | r <= 0 && g <= 95 && b <= 0 = 6
42− | r <= 0 && g <= 95 && b <= 95 = 7
43− | r <= 0 && g <= 95 && b <= 135 = 8
44− | r <= 0 && g <= 95 && b <= 175 = 9
45− | r <= 0 && g <= 95 && b <= 215 = 10
46− | r <= 0 && g <= 95 && b <= 255 = 11
47− | r <= 0 && g <= 135 && b <= 0 = 12
48− | r <= 0 && g <= 135 && b <= 95 = 13
49− | r <= 0 && g <= 135 && b <= 135 = 14
50− | r <= 0 && g <= 135 && b <= 175 = 15
51− | r <= 0 && g <= 135 && b <= 215 = 16
52− | r <= 0 && g <= 135 && b <= 255 = 17
53− | r <= 0 && g <= 175 && b <= 0 = 18
54− | r <= 0 && g <= 175 && b <= 95 = 19
55− | r <= 0 && g <= 175 && b <= 135 = 20
56− | r <= 0 && g <= 175 && b <= 175 = 21
57− | r <= 0 && g <= 175 && b <= 215 = 22
58− | r <= 0 && g <= 175 && b <= 255 = 23
59− | r <= 0 && g <= 215 && b <= 0 = 24
60− | r <= 0 && g <= 215 && b <= 95 = 25
61− | r <= 0 && g <= 215 && b <= 135 = 26
62− | r <= 0 && g <= 215 && b <= 175 = 27
63− | r <= 0 && g <= 215 && b <= 215 = 28
64− | r <= 0 && g <= 215 && b <= 255 = 29
65− | r <= 0 && g <= 255 && b <= 0 = 30
66− | r <= 0 && g <= 255 && b <= 95 = 31
67− | r <= 0 && g <= 255 && b <= 135 = 32
68− | r <= 0 && g <= 255 && b <= 175 = 33
69− | r <= 0 && g <= 255 && b <= 215 = 34
70− | r <= 0 && g <= 255 && b <= 255 = 35
71− | r <= 95 && g <= 0 && b <= 0 = 36
72− | r <= 95 && g <= 0 && b <= 95 = 37
73− | r <= 95 && g <= 0 && b <= 135 = 38
74− | r <= 95 && g <= 0 && b <= 175 = 39
75− | r <= 95 && g <= 0 && b <= 215 = 40
76− | r <= 95 && g <= 0 && b <= 255 = 41
77− | r <= 95 && g <= 95 && b <= 0 = 42
78− | r <= 95 && g <= 95 && b <= 95 = 43
79− | r <= 95 && g <= 95 && b <= 135 = 44
80− | r <= 95 && g <= 95 && b <= 175 = 45
81− | r <= 95 && g <= 95 && b <= 215 = 46
82− | r <= 95 && g <= 95 && b <= 255 = 47
83− | r <= 95 && g <= 135 && b <= 0 = 48
84− | r <= 95 && g <= 135 && b <= 95 = 49
85− | r <= 95 && g <= 135 && b <= 135 = 50
86− | r <= 95 && g <= 135 && b <= 175 = 51
87− | r <= 95 && g <= 135 && b <= 215 = 52
88− | r <= 95 && g <= 135 && b <= 255 = 53
89− | r <= 95 && g <= 175 && b <= 0 = 54
90− | r <= 95 && g <= 175 && b <= 95 = 55
91− | r <= 95 && g <= 175 && b <= 135 = 56
92− | r <= 95 && g <= 175 && b <= 175 = 57
93− | r <= 95 && g <= 175 && b <= 215 = 58
94− | r <= 95 && g <= 175 && b <= 255 = 59
95− | r <= 95 && g <= 215 && b <= 0 = 60
96− | r <= 95 && g <= 215 && b <= 95 = 61
97− | r <= 95 && g <= 215 && b <= 135 = 62
98− | r <= 95 && g <= 215 && b <= 175 = 63
99− | r <= 95 && g <= 215 && b <= 215 = 64
100− | r <= 95 && g <= 215 && b <= 255 = 65
101− | r <= 95 && g <= 255 && b <= 0 = 66
102− | r <= 95 && g <= 255 && b <= 95 = 67
103− | r <= 95 && g <= 255 && b <= 135 = 68
104− | r <= 95 && g <= 255 && b <= 175 = 69
105− | r <= 95 && g <= 255 && b <= 215 = 70
106− | r <= 95 && g <= 255 && b <= 255 = 71
107− | r <= 135 && g <= 0 && b <= 0 = 72
108− | r <= 135 && g <= 0 && b <= 95 = 73
109− | r <= 135 && g <= 0 && b <= 135 = 74
110− | r <= 135 && g <= 0 && b <= 175 = 75
111− | r <= 135 && g <= 0 && b <= 215 = 76
112− | r <= 135 && g <= 0 && b <= 255 = 77
113− | r <= 135 && g <= 95 && b <= 0 = 78
114− | r <= 135 && g <= 95 && b <= 95 = 79
115− | r <= 135 && g <= 95 && b <= 135 = 80
116− | r <= 135 && g <= 95 && b <= 175 = 81
117− | r <= 135 && g <= 95 && b <= 215 = 82
118− | r <= 135 && g <= 95 && b <= 255 = 83
119− | r <= 135 && g <= 135 && b <= 0 = 84
120− | r <= 135 && g <= 135 && b <= 95 = 85
121− | r <= 135 && g <= 135 && b <= 135 = 86
122− | r <= 135 && g <= 135 && b <= 175 = 87
123− | r <= 135 && g <= 135 && b <= 215 = 88
124− | r <= 135 && g <= 135 && b <= 255 = 89
125− | r <= 135 && g <= 175 && b <= 0 = 90
126− | r <= 135 && g <= 175 && b <= 95 = 91
127− | r <= 135 && g <= 175 && b <= 135 = 92
128− | r <= 135 && g <= 175 && b <= 175 = 93
129− | r <= 135 && g <= 175 && b <= 215 = 94
130− | r <= 135 && g <= 175 && b <= 255 = 95
131− | r <= 135 && g <= 215 && b <= 0 = 96
132− | r <= 135 && g <= 215 && b <= 95 = 97
133− | r <= 135 && g <= 215 && b <= 135 = 98
134− | r <= 135 && g <= 215 && b <= 175 = 99
135− | r <= 135 && g <= 215 && b <= 215 = 100
136− | r <= 135 && g <= 215 && b <= 255 = 101
137− | r <= 135 && g <= 255 && b <= 0 = 102
138− | r <= 135 && g <= 255 && b <= 95 = 103
139− | r <= 135 && g <= 255 && b <= 135 = 104
140− | r <= 135 && g <= 255 && b <= 175 = 105
141− | r <= 135 && g <= 255 && b <= 215 = 106
142− | r <= 135 && g <= 255 && b <= 255 = 107
143− | r <= 175 && g <= 0 && b <= 0 = 108
144− | r <= 175 && g <= 0 && b <= 95 = 109
145− | r <= 175 && g <= 0 && b <= 135 = 110
146− | r <= 175 && g <= 0 && b <= 175 = 111
147− | r <= 175 && g <= 0 && b <= 215 = 112
148− | r <= 175 && g <= 0 && b <= 255 = 113
149− | r <= 175 && g <= 95 && b <= 0 = 114
150− | r <= 175 && g <= 95 && b <= 95 = 115
151− | r <= 175 && g <= 95 && b <= 135 = 116
152− | r <= 175 && g <= 95 && b <= 175 = 117
153− | r <= 175 && g <= 95 && b <= 215 = 118
154− | r <= 175 && g <= 95 && b <= 255 = 119
155− | r <= 175 && g <= 135 && b <= 0 = 120
156− | r <= 175 && g <= 135 && b <= 95 = 121
157− | r <= 175 && g <= 135 && b <= 135 = 122
158− | r <= 175 && g <= 135 && b <= 175 = 123
159− | r <= 175 && g <= 135 && b <= 215 = 124
160− | r <= 175 && g <= 135 && b <= 255 = 125
161− | r <= 175 && g <= 175 && b <= 0 = 126
162− | r <= 175 && g <= 175 && b <= 95 = 127
163− | r <= 175 && g <= 175 && b <= 135 = 128
164− | r <= 175 && g <= 175 && b <= 175 = 129
165− | r <= 175 && g <= 175 && b <= 215 = 130
166− | r <= 175 && g <= 175 && b <= 255 = 131
167− | r <= 175 && g <= 215 && b <= 0 = 132
168− | r <= 175 && g <= 215 && b <= 95 = 133
169− | r <= 175 && g <= 215 && b <= 135 = 134
170− | r <= 175 && g <= 215 && b <= 175 = 135
171− | r <= 175 && g <= 215 && b <= 215 = 136
172− | r <= 175 && g <= 215 && b <= 255 = 137
173− | r <= 175 && g <= 255 && b <= 0 = 138
174− | r <= 175 && g <= 255 && b <= 95 = 139
175− | r <= 175 && g <= 255 && b <= 135 = 140
176− | r <= 175 && g <= 255 && b <= 175 = 141
177− | r <= 175 && g <= 255 && b <= 215 = 142
178− | r <= 175 && g <= 255 && b <= 255 = 143
179− | r <= 215 && g <= 0 && b <= 0 = 144
180− | r <= 215 && g <= 0 && b <= 95 = 145
181− | r <= 215 && g <= 0 && b <= 135 = 146
182− | r <= 215 && g <= 0 && b <= 175 = 147
183− | r <= 215 && g <= 0 && b <= 215 = 148
184− | r <= 215 && g <= 0 && b <= 255 = 149
185− | r <= 215 && g <= 95 && b <= 0 = 150
186− | r <= 215 && g <= 95 && b <= 95 = 151
187− | r <= 215 && g <= 95 && b <= 135 = 152
188− | r <= 215 && g <= 95 && b <= 175 = 153
189− | r <= 215 && g <= 95 && b <= 215 = 154
190− | r <= 215 && g <= 95 && b <= 255 = 155
191− | r <= 215 && g <= 135 && b <= 0 = 156
192− | r <= 215 && g <= 135 && b <= 95 = 157
193− | r <= 215 && g <= 135 && b <= 135 = 158
194− | r <= 215 && g <= 135 && b <= 175 = 159
195− | r <= 215 && g <= 135 && b <= 215 = 160
196− | r <= 215 && g <= 135 && b <= 255 = 161
197− | r <= 215 && g <= 175 && b <= 0 = 162
198− | r <= 215 && g <= 175 && b <= 95 = 163
199− | r <= 215 && g <= 175 && b <= 135 = 164
200− | r <= 215 && g <= 175 && b <= 175 = 165
201− | r <= 215 && g <= 175 && b <= 215 = 166
202− | r <= 215 && g <= 175 && b <= 255 = 167
203− | r <= 215 && g <= 215 && b <= 0 = 168
204− | r <= 215 && g <= 215 && b <= 95 = 169
205− | r <= 215 && g <= 215 && b <= 135 = 170
206− | r <= 215 && g <= 215 && b <= 175 = 171
207− | r <= 215 && g <= 215 && b <= 215 = 172
208− | r <= 215 && g <= 215 && b <= 255 = 173
209− | r <= 215 && g <= 255 && b <= 0 = 174
210− | r <= 215 && g <= 255 && b <= 95 = 175
211− | r <= 215 && g <= 255 && b <= 135 = 176
212− | r <= 215 && g <= 255 && b <= 175 = 177
213− | r <= 215 && g <= 255 && b <= 215 = 178
214− | r <= 215 && g <= 255 && b <= 255 = 179
215− | r <= 255 && g <= 0 && b <= 0 = 180
216− | r <= 255 && g <= 0 && b <= 95 = 181
217− | r <= 255 && g <= 0 && b <= 135 = 182
218− | r <= 255 && g <= 0 && b <= 175 = 183
219− | r <= 255 && g <= 0 && b <= 215 = 184
220− | r <= 255 && g <= 0 && b <= 255 = 185
221− | r <= 255 && g <= 95 && b <= 0 = 186
222− | r <= 255 && g <= 95 && b <= 95 = 187
223− | r <= 255 && g <= 95 && b <= 135 = 188
224− | r <= 255 && g <= 95 && b <= 175 = 189
225− | r <= 255 && g <= 95 && b <= 215 = 190
226− | r <= 255 && g <= 95 && b <= 255 = 191
227− | r <= 255 && g <= 135 && b <= 0 = 192
228− | r <= 255 && g <= 135 && b <= 95 = 193
229− | r <= 255 && g <= 135 && b <= 135 = 194
230− | r <= 255 && g <= 135 && b <= 175 = 195
231− | r <= 255 && g <= 135 && b <= 215 = 196
232− | r <= 255 && g <= 135 && b <= 255 = 197
233− | r <= 255 && g <= 175 && b <= 0 = 198
234− | r <= 255 && g <= 175 && b <= 95 = 199
235− | r <= 255 && g <= 175 && b <= 135 = 200
236− | r <= 255 && g <= 175 && b <= 175 = 201
237− | r <= 255 && g <= 175 && b <= 215 = 202
238− | r <= 255 && g <= 175 && b <= 255 = 203
239− | r <= 255 && g <= 215 && b <= 0 = 204
240− | r <= 255 && g <= 215 && b <= 95 = 205
241− | r <= 255 && g <= 215 && b <= 135 = 206
242− | r <= 255 && g <= 215 && b <= 175 = 207
243− | r <= 255 && g <= 215 && b <= 215 = 208
244− | r <= 255 && g <= 215 && b <= 255 = 209
245− | r <= 255 && g <= 255 && b <= 0 = 210
246− | r <= 255 && g <= 255 && b <= 95 = 211
247− | r <= 255 && g <= 255 && b <= 135 = 212
248− | r <= 255 && g <= 255 && b <= 175 = 213
249− | r <= 255 && g <= 255 && b <= 215 = 214
250− | r <= 255 && g <= 255 && b <= 255 = 215
251− | otherwise = error (printf "RGB color %d %d %d does not map to 240 palette."
252− (fromIntegral r :: Int)
253− (fromIntegral g :: Int)
254− (fromIntegral b :: Int))
255−
256−sameColor :: Int -> Int -> Int -> Bool
257−sameColor r g b = oldRgbColorToColor240 r g b == rgbColorToColor240 r g b
258−
259−genVal :: Gen Int
260−genVal = chooseInt (0, 255)
261−
262−sameColorCheck :: Property
263−sameColorCheck = forAll genVal (\r -> forAll genVal (\g -> forAll genVal (sameColor r g)))
264−
265−tests :: IO [Test]
266−tests = return
267− [ verify "check rgbColorToColor240 optimization is correct" sameColorCheck
268− ]
269−
test/VerifyEmptyImageProps.hs−1
@@ -1,4 +1,3 @@
1−{-# LANGUAGE ScopedTypeVariables #-}
21module VerifyEmptyImageProps where
32
43import Verify
test/VerifyEvalTerminfoCaps.hs−1
@@ -1,6 +1,5 @@
11{-# LANGUAGE BangPatterns #-}
22{-# LANGUAGE NamedFieldPuns #-}
3−{-# LANGUAGE ScopedTypeVariables #-}
43module VerifyEvalTerminfoCaps where
54
65import Blaze.ByteString.Builder.Internal.Write (runWrite, getBound)
test/VerifyImageOps.hs+1−2
@@ -1,4 +1,3 @@
1−{-# LANGUAGE ScopedTypeVariables #-}
21module VerifyImageOps where
32
43import Graphics.Vty.Attributes
@@ -137,7 +136,7 @@ cropBottomLimitsHeight :: Image -> Int -> Property
137136cropBottomLimitsHeight i v = v >= 0 ==>
138137 v >= imageHeight (cropBottom v i)
139138
140−-- ridiculous tests just to satisfy my desire for nice code coverage :-P
139+-- rediculous tests just to satisfy my desire for nice code coverage :-P
141140canShowImage :: Image -> Bool
142141canShowImage i = length (show i) > 0
143142
test/VerifyOutput.hs+2−7
@@ -1,7 +1,6 @@
1−-- We setup the environment to invoke certain terminals of interest.
1+-- We setup the environment to envoke certain terminals of interest.
22-- This assumes appropriate definitions exist in the current environment
33-- for the terminals of interest.
4−{-# LANGUAGE ScopedTypeVariables #-}
54module VerifyOutput where
65
76import Verify
@@ -35,11 +34,7 @@ smokeTestTermNonMac termName i = liftIOResult $ do
3534smokeTestTerm :: String -> Image -> IO Result
3635smokeTestTerm termName i = do
3736 nullOut <- openFd "/dev/null" WriteOnly Nothing defaultFileFlags
38− t <- outputForConfig $ defaultConfig
39− { outputFd = Just nullOut
40− , termName = Just termName
41− , colorMode = Just NoColor
42− }
37+ t <- outputForConfig $ defaultConfig { outputFd = Just nullOut, termName = Just termName }
4338 -- putStrLn $ "context color count: " ++ show (contextColorCount t)
4439 reserveDisplay t
4540 dc <- displayContext t (100,100)
test/VerifyParseTerminfoCaps.hs−1
@@ -1,5 +1,4 @@
11{-# LANGUAGE NamedFieldPuns #-}
2−{-# LANGUAGE ScopedTypeVariables #-}
32module VerifyParseTerminfoCaps where
43
54import Prelude hiding ( catch )
test/VerifyUsingMockInput.hs+1−4
@@ -1,6 +1,5 @@
11{-# LANGUAGE MultiParamTypeClasses #-}
22{-# LANGUAGE FlexibleInstances #-}
3−{-# LANGUAGE ScopedTypeVariables #-}
43-- Generate some input bytes and delays between blocks of input bytes.
54-- Verify the events produced are as expected.
65module Main where
@@ -132,9 +131,7 @@ assertEventsFromSynInput table inputSpec expectedEvents = do
132131 readLoop 0 = return ()
133132 readLoop n = do
134133 e <- atomically $ readTChan $ input^.eventChannel
135− case e of
136− InputEvent ev -> modifyIORef eventsRef ((:) ev)
137− ResumeAfterSignal -> return ()
134+ modifyIORef eventsRef ((:) e)
138135 readLoop (n - 1)
139136 genEventsUsingIoActions maxDuration writeWaitClose readEvents
140137 outEvents <- reverse <$> readIORef eventsRef
test/interactive_terminal_test.hs+1−1
@@ -364,7 +364,7 @@ Did the test output match the description?
364364|]
365365 defaultSuccessConfirmResults
366366
367−-- Explicitly define the bytes that encode each example text.
367+-- Explicitely definethe bytes that encode each example text.
368368-- This avoids any issues with how the compiler represents string literals.
369369--
370370-- This document is UTF-8 encoded so the UTF-8 string is still included for
vty.cabal+38−46
@@ -1,5 +1,5 @@
11name: vty
2−version: 5.35.1
2+version: 5.30
33license: BSD3
44license-file: LICENSE
55author: AUTHORS
@@ -45,7 +45,7 @@ library
4545 deepseq >= 1.1 && < 1.5,
4646 directory,
4747 filepath >= 1.0 && < 2.0,
48− microlens < 0.4.13,
48+ microlens < 0.4.12,
4949 microlens-mtl,
5050 microlens-th,
5151 hashable >= 1.2,
@@ -69,7 +69,6 @@ library
6969 exposed-modules: Graphics.Vty
7070 Graphics.Vty.Attributes
7171 Graphics.Vty.Attributes.Color
72− Graphics.Vty.Attributes.Color240
7372 Graphics.Vty.Config
7473 Graphics.Vty.Error
7574 Graphics.Vty.Image
@@ -105,7 +104,8 @@ library
105104 Graphics.Vty.UnicodeWidthTable.Query
106105 Graphics.Vty.UnicodeWidthTable.Install
107106
108− other-modules: Graphics.Vty.Debug.Image
107+ other-modules: Graphics.Vty.Attributes.Color240
108+ Graphics.Vty.Debug.Image
109109 Graphics.Vty.Input.Terminfo.ANSIVT
110110
111111 c-sources: cbits/gwinsz.c
@@ -117,6 +117,8 @@ library
117117
118118 hs-source-dirs: src
119119
120+ default-extensions: ScopedTypeVariables
121+
120122 ghc-options: -O2 -funbox-strict-fields -Wall -fspec-constr -fspec-constr-count=10
121123
122124 ghc-prof-options: -O2 -funbox-strict-fields -caf-all -Wall -fspec-constr -fspec-constr-count=10
@@ -141,6 +143,7 @@ executable vty-mode-demo
141143 hs-source-dirs: demos
142144
143145 default-language: Haskell2010
146+ default-extensions: ScopedTypeVariables
144147 ghc-options: -threaded
145148
146149 build-depends: vty,
@@ -155,6 +158,7 @@ executable vty-demo
155158 hs-source-dirs: demos
156159
157160 default-language: Haskell2010
161+ default-extensions: ScopedTypeVariables
158162 ghc-options: -threaded
159163
160164 build-depends: vty,
@@ -166,6 +170,7 @@ executable vty-demo
166170
167171test-suite verify-using-mock-terminal
168172 default-language: Haskell2010
173+ default-extensions: ScopedTypeVariables
169174
170175 type: detailed-0.9
171176
@@ -184,7 +189,7 @@ test-suite verify-using-mock-terminal
184189 build-depends: vty,
185190 Cabal >= 1.20,
186191 QuickCheck >= 2.7,
187− random >= 1.0 && < 1.3,
192+ random >= 1.0 && < 1.2,
188193 base >= 4.8 && < 5,
189194 bytestring,
190195 containers,
@@ -198,6 +203,7 @@ test-suite verify-using-mock-terminal
198203
199204test-suite verify-terminal
200205 default-language: Haskell2010
206+ default-extensions: ScopedTypeVariables
201207
202208 type: detailed-0.9
203209
@@ -216,7 +222,7 @@ test-suite verify-terminal
216222 build-depends: vty,
217223 Cabal >= 1.20,
218224 QuickCheck >= 2.7,
219− random >= 1.0 && < 1.3,
225+ random >= 1.0 && < 1.2,
220226 base >= 4.8 && < 5,
221227 bytestring,
222228 containers,
@@ -230,6 +236,7 @@ test-suite verify-terminal
230236
231237test-suite verify-display-attributes
232238 default-language: Haskell2010
239+ default-extensions: ScopedTypeVariables
233240
234241 type: detailed-0.9
235242
@@ -248,7 +255,7 @@ test-suite verify-display-attributes
248255 build-depends: vty,
249256 Cabal >= 1.20,
250257 QuickCheck >= 2.7,
251− random >= 1.0 && < 1.3,
258+ random >= 1.0 && < 1.2,
252259 base >= 4.8 && < 5,
253260 bytestring,
254261 containers,
@@ -261,6 +268,7 @@ test-suite verify-display-attributes
261268
262269test-suite verify-empty-image-props
263270 default-language: Haskell2010
271+ default-extensions: ScopedTypeVariables
264272
265273 type: detailed-0.9
266274
@@ -273,7 +281,7 @@ test-suite verify-empty-image-props
273281 build-depends: vty,
274282 Cabal >= 1.20,
275283 QuickCheck >= 2.7,
276− random >= 1.0 && < 1.3,
284+ random >= 1.0 && < 1.2,
277285 base >= 4.8 && < 5,
278286 bytestring,
279287 containers,
@@ -286,6 +294,7 @@ test-suite verify-empty-image-props
286294
287295test-suite verify-eval-terminfo-caps
288296 default-language: Haskell2010
297+ default-extensions: ScopedTypeVariables
289298
290299 type: detailed-0.9
291300
@@ -299,7 +308,7 @@ test-suite verify-eval-terminfo-caps
299308 build-depends: vty,
300309 Cabal >= 1.20,
301310 QuickCheck >= 2.7,
302− random >= 1.0 && < 1.3,
311+ random >= 1.0 && < 1.2,
303312 base >= 4.8 && < 5,
304313 blaze-builder >= 0.3.3.2 && < 0.5,
305314 bytestring,
@@ -314,6 +323,7 @@ test-suite verify-eval-terminfo-caps
314323
315324test-suite verify-image-ops
316325 default-language: Haskell2010
326+ default-extensions: ScopedTypeVariables
317327
318328 type: detailed-0.9
319329
@@ -328,7 +338,7 @@ test-suite verify-image-ops
328338 build-depends: vty,
329339 Cabal >= 1.20,
330340 QuickCheck >= 2.7,
331− random >= 1.0 && < 1.3,
341+ random >= 1.0 && < 1.2,
332342 base >= 4.8 && < 5,
333343 bytestring,
334344 containers,
@@ -341,6 +351,7 @@ test-suite verify-image-ops
341351
342352test-suite verify-image-trans
343353 default-language: Haskell2010
354+ default-extensions: ScopedTypeVariables
344355
345356 type: detailed-0.9
346357
@@ -355,7 +366,7 @@ test-suite verify-image-trans
355366 build-depends: vty,
356367 Cabal >= 1.20,
357368 QuickCheck >= 2.7,
358− random >= 1.0 && < 1.3,
369+ random >= 1.0 && < 1.2,
359370 base >= 4.8 && < 5,
360371 bytestring,
361372 containers,
@@ -368,6 +379,7 @@ test-suite verify-image-trans
368379
369380test-suite verify-inline
370381 default-language: Haskell2010
382+ default-extensions: ScopedTypeVariables
371383
372384 type: detailed-0.9
373385
@@ -381,7 +393,7 @@ test-suite verify-inline
381393 build-depends: vty,
382394 Cabal >= 1.20,
383395 QuickCheck >= 2.7,
384− random >= 1.0 && < 1.3,
396+ random >= 1.0 && < 1.2,
385397 base >= 4.8 && < 5,
386398 bytestring,
387399 containers,
@@ -394,6 +406,7 @@ test-suite verify-inline
394406
395407test-suite verify-parse-terminfo-caps
396408 default-language: Haskell2010
409+ default-extensions: ScopedTypeVariables
397410
398411 type: detailed-0.9
399412
@@ -408,7 +421,7 @@ test-suite verify-parse-terminfo-caps
408421 build-depends: vty,
409422 Cabal >= 1.20,
410423 QuickCheck >= 2.7,
411− random >= 1.0 && < 1.3,
424+ random >= 1.0 && < 1.2,
412425 base >= 4.8 && < 5,
413426 bytestring,
414427 containers,
@@ -422,6 +435,7 @@ test-suite verify-parse-terminfo-caps
422435
423436test-suite verify-simple-span-generation
424437 default-language: Haskell2010
438+ default-extensions: ScopedTypeVariables
425439
426440 type: detailed-0.9
427441
@@ -439,7 +453,7 @@ test-suite verify-simple-span-generation
439453 build-depends: vty,
440454 Cabal >= 1.20,
441455 QuickCheck >= 2.7,
442− random >= 1.0 && < 1.3,
456+ random >= 1.0 && < 1.2,
443457 base >= 4.8 && < 5,
444458 bytestring,
445459 containers,
@@ -453,6 +467,7 @@ test-suite verify-simple-span-generation
453467
454468test-suite verify-crop-span-generation
455469 default-language: Haskell2010
470+ default-extensions: ScopedTypeVariables
456471
457472 type: detailed-0.9
458473
@@ -470,7 +485,7 @@ test-suite verify-crop-span-generation
470485 build-depends: vty,
471486 Cabal >= 1.20,
472487 QuickCheck >= 2.7,
473− random >= 1.0 && < 1.3,
488+ random >= 1.0 && < 1.2,
474489 base >= 4.8 && < 5,
475490 bytestring,
476491 containers,
@@ -484,6 +499,7 @@ test-suite verify-crop-span-generation
484499
485500test-suite verify-layers-span-generation
486501 default-language: Haskell2010
502+ default-extensions: ScopedTypeVariables
487503
488504 type: detailed-0.9
489505
@@ -501,32 +517,7 @@ test-suite verify-layers-span-generation
501517 build-depends: vty,
502518 Cabal >= 1.20,
503519 QuickCheck >= 2.7,
504− random >= 1.0 && < 1.3,
505− base >= 4.8 && < 5,
506− bytestring,
507− containers,
508− deepseq >= 1.1 && < 1.5,
509− mtl >= 1.1.1.0 && < 2.3,
510− text >= 0.11.3,
511− unix,
512− utf8-string >= 0.3 && < 1.1,
513− vector >= 0.7
514−
515−test-suite verify-color-mapping
516− default-language: Haskell2010
517−
518− type: detailed-0.9
519−
520− hs-source-dirs: test
521−
522− test-module: VerifyColor240
523−
524− other-modules: Verify
525−
526− build-depends: vty,
527− Cabal >= 1.20,
528− QuickCheck >= 2.7,
529− random >= 1.0 && < 1.3,
520+ random >= 1.0 && < 1.2,
530521 base >= 4.8 && < 5,
531522 bytestring,
532523 containers,
@@ -539,6 +530,7 @@ test-suite verify-color-mapping
539530
540531test-suite verify-utf8-width
541532 default-language: Haskell2010
533+ default-extensions: ScopedTypeVariables
542534
543535 type: detailed-0.9
544536
@@ -551,7 +543,7 @@ test-suite verify-utf8-width
551543 build-depends: vty,
552544 Cabal >= 1.20,
553545 QuickCheck >= 2.7,
554− random >= 1.0 && < 1.3,
546+ random >= 1.0 && < 1.2,
555547 base >= 4.8 && < 5,
556548 bytestring,
557549 containers,
@@ -564,6 +556,7 @@ test-suite verify-utf8-width
564556
565557test-suite verify-using-mock-input
566558 default-language: Haskell2010
559+ default-extensions: ScopedTypeVariables
567560
568561 type: exitcode-stdio-1.0
569562
@@ -571,8 +564,6 @@ test-suite verify-using-mock-input
571564
572565 main-is: VerifyUsingMockInput.hs
573566
574− other-modules: Verify.Graphics.Vty.Output
575−
576567 build-depends: vty,
577568 Cabal >= 1.20,
578569 QuickCheck >= 2.7,
@@ -580,7 +571,7 @@ test-suite verify-using-mock-input
580571 quickcheck-assertions >= 0.1.1,
581572 test-framework == 0.8.*,
582573 test-framework-smallcheck == 0.2.*,
583− random >= 1.0 && < 1.3,
574+ random >= 1.0 && < 1.2,
584575 base >= 4.8 && < 5,
585576 bytestring,
586577 containers,
@@ -599,6 +590,7 @@ test-suite verify-using-mock-input
599590
600591test-suite verify-config
601592 default-language: Haskell2010
593+ default-extensions: ScopedTypeVariables
602594
603595 type: exitcode-stdio-1.0
604596
@@ -615,7 +607,7 @@ test-suite verify-config
615607 test-framework == 0.8.*,
616608 test-framework-smallcheck == 0.2.*,
617609 test-framework-hunit,
618− random >= 1.0 && < 1.3,
610+ random >= 1.0 && < 1.2,
619611 base >= 4.8 && < 5,
620612 bytestring,
621613 containers,