git.iko.soy/vty
on master help sign in
swap
4a29aec114 ahead, 0 behind
46 files changed+1127−612
since splitsnapshots
unifiedsplit
CHANGELOG.md+139 LICENSE+2 cbits/gwinsz.c+14−5 cbits/gwinsz.h+2−1 demos/Demo.hs+12−4 src/Codec/Binary/UTF8/Debug.hs+1−2 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+39−10 src/Graphics/Vty/Attributes.hs+8−46 src/Graphics/Vty/Attributes/Color.hs+67−3 src/Graphics/Vty/Attributes/Color240.hs+10−218 src/Graphics/Vty/Config.hs+11−2 src/Graphics/Vty/DisplayAttributes.hs+3 src/Graphics/Vty/Image.hs+11−10 src/Graphics/Vty/Image/Internal.hs+3−3 src/Graphics/Vty/Inline.hs+5−7 src/Graphics/Vty/Input.hs+11−22 src/Graphics/Vty/Input/Classify.hs+53−29 src/Graphics/Vty/Input/Classify/Parse.hs+10−7 src/Graphics/Vty/Input/Classify/Types.hs+7−1 src/Graphics/Vty/Input/Events.hs+24−6 src/Graphics/Vty/Input/Focus.hs+15−13 src/Graphics/Vty/Input/Loop.hs+86−29 src/Graphics/Vty/Input/Mouse.hs+19−17 src/Graphics/Vty/Input/Paste.hs+16−24 src/Graphics/Vty/Input/Terminfo.hs+6−4 src/Graphics/Vty/Input/Terminfo/ANSIVT.hs+1−1 src/Graphics/Vty/Output.hs+6−5 src/Graphics/Vty/Output/Interface.hs+47−18 src/Graphics/Vty/Output/Mock.hs+6−2 src/Graphics/Vty/Output/TerminfoBased.hs+106−39 src/Graphics/Vty/Output/XTermColor.hs+27−18 src/Graphics/Vty/Picture.hs+8−1 src/Graphics/Vty/PictureToSpans.hs+4−4 src/Graphics/Vty/Span.hs+2−4 test/VerifyColor240.hs+269 test/VerifyEmptyImageProps.hs+1 test/VerifyEvalTerminfoCaps.hs+1 test/VerifyImageOps.hs+2−1 test/VerifyOutput.hs+7−2 test/VerifyParseTerminfoCaps.hs+1 test/VerifyUsingMockInput.hs+4−1 test/interactive_terminal_test.hs+1−1 vty.cabal+46−38
CHANGELOG.md+139
@@ -1,4 +1,143 @@
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+
113+5.30
114+----
115+
116+New features:
117+ * Added `Graphics.Vty.setWindowTitle` to emit an escape
118+ sequence to set the window title, provide the terminal emulator
119+ accepts Xterm-style title sequences. For details, see:
120+ https://tldp.org/HOWTO/Xterm-Title-3.html
121+
122+5.29
123+----
124+
125+API changes:
126+ * The Input type got a new field, 'restoreInputState'. This field
127+ allows the end user to have direct access to the logic needed to
128+ restore the terminal's input state flags. Prior to having this field,
129+ this state restoration logic could only be invoked as part of calling
130+ 'shutdownInput', but since that function does other things (like
131+ killing threads) it is not advisable to call it repeatedly (which is
132+ necessary in the use case this change is intended to support). This
133+ can be called directly to restore the input state flags as needed,
134+ although this is not required if 'shutdown' (or 'shutdownInput') is
135+ called.
136+
137+Other changes:
138+ * attributeControl: explicitly enable the ICRNL terminal mode flag (see
139+ #187 and c572ad).
140+
21415.28.2
3142------
4143
LICENSE+2
@@ -1,3 +1,5 @@
1+BSD 3-Clause License
2+
13Copyright Stefan O'Rear 2006, Corey O'Connor 2008, Corey O'Connor 2009
24
35All rights reserved.
cbits/gwinsz.c+14−5
@@ -1,9 +1,18 @@
11#include <sys/ioctl.h>
22
33unsigned long vty_c_get_window_size(int fd) {
4− struct winsize w;
5− if (ioctl (fd, TIOCGWINSZ, &w) >= 0)
6− return (w.ws_row << 16) + w.ws_col;
7− else
8− return 0x190050;
4+ struct winsize w;
5+ if (ioctl (fd, TIOCGWINSZ, &w) >= 0)
6+ return (w.ws_row << 16) + w.ws_col;
7+ else
8+ return 0x190050;
9+}
10+
11+void vty_c_set_window_size(int fd, unsigned long val) {
12+ struct winsize w;
13+ if (ioctl(fd, TIOCGWINSZ, &w) >= 0) {
14+ w.ws_row = val >> 16;
15+ w.ws_col = val & 0xFFFF;
16+ ioctl(fd, TIOCSWINSZ, &w);
17+ }
918}
cbits/gwinsz.h+2−1
@@ -1 +1,2 @@
1−unsigned long vty_c_get_window_size(void);
1+unsigned long vty_c_get_window_size(int fd);
2+unsigned long vty_c_set_window_size(int fd, unsigned long val);
demos/Demo.hs+12−4
@@ -31,7 +31,8 @@ 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 pallete."
34+ , "Followed by a description of the 16 color palette."
35+ , "Followed by tones of red using a 24-bit palette."
3536 , "If the 240 color box is not visible then the terminal"
3637 , "claims 240 colors are not supported."
3738 , "Try setting TERM to xterm-256color"
@@ -42,12 +43,19 @@ introText = vertCat $ map (string defAttr)
4243 , "¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯"
4344 ]
4445
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+
4555colorbox_240 :: Image
4656colorbox_240 = vertCat $ map horizCat $ splitColorImages colorImages
4757 where
4858 colorImages = map (\i -> string (currentAttr `withBackColor` Color240 i) " ") [0..239]
49− splitColorImages [] = []
50− splitColorImages is = (take 20 is ++ [string defAttr " "]) : (splitColorImages (drop 20 is))
5159
5260colorbox_16 :: Image
5361colorbox_16 = border <|> column0 <|> border <|> column1 <|> border <|> column2 <|> border
@@ -70,7 +78,7 @@ updateDisplay = do
7078 "Press ESC to exit. Events for keys below."
7179 eventLog <- foldMap (string defAttr) <$> get
7280 let pic = picForImage (info <-> eventLog)
73− `addToBottom` (introText <-> colorbox_240 <|> colorbox_16)
81+ `addToBottom` (introText <-> colorbox_240 <|> colorbox_16 <|> fullcolorbox)
7482 vty <- ask
7583 liftIO $ update vty pic
7684
src/Codec/Binary/UTF8/Debug.hs+1−2
@@ -14,5 +14,4 @@ utf8FromIso :: [Int] -> [Word8]
1414utf8FromIso = encode . map toEnum
1515
1616ppUtf8 :: [Int] -> IO ()
17−ppUtf8 = print . map (\f -> f "") . map showHex . utf8FromIso
18−
17+ppUtf8 = print . map (`showHex` "") . utf8FromIso
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 = \v -> rnf' (viewl v)
10+ rnf = rnf' . viewl
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 <- get >>= return . evalParams
45+ !params <- evalParams <$> get
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 ops = mapM_ writeCapOp ops
67+writeCapOps = mapM_ writeCapOp
6868
6969writeCapOp :: CapOp -> Eval ()
7070writeCapOp (Bytes !offset !count) = do
71− !cap <- get >>= return . evalExpression
71+ !cap <- evalExpression <$> get
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 #-}
43{-# LANGUAGE NoMonomorphismRestriction #-}
5−{-# LANGUAGE NamedFieldPuns #-}
4+{-# LANGUAGE ScopedTypeVariables #-}
65{-# 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 (\b s -> showHex b s) ""
42+ hexDump = foldr showHex ""
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 :: [Char] -> BuildResults -> CapExpression
102+constructCapExpression :: String -> 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 <- getState >>= return . nextOffset
131+ startOffset <- nextOffset <$> getState
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 <- digit >>= return . (\d -> read [d])
157+ paramN <- read . pure <$> digit
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 <- getState >>= return . nextOffset
302+ startOffset <- nextOffset <$> getState
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+39−10
@@ -1,4 +1,5 @@
11{-# LANGUAGE CPP #-}
2+{-# LANGUAGE ScopedTypeVariables #-}
23
34-- | Vty provides interfaces for both terminal input and terminal
45-- output.
@@ -33,6 +34,7 @@
3334module Graphics.Vty
3435 ( Vty(..)
3536 , mkVty
37+ , setWindowTitle
3638 , Mode(..)
3739 , module Graphics.Vty.Config
3840 , module Graphics.Vty.Input
@@ -46,6 +48,7 @@ where
4648
4749import Graphics.Vty.Config
4850import Graphics.Vty.Input
51+import Graphics.Vty.Input.Events
4952import Graphics.Vty.Output
5053import Graphics.Vty.Output.Interface
5154import Graphics.Vty.Picture
@@ -54,6 +57,9 @@ import Graphics.Vty.Attributes
5457import Graphics.Vty.UnicodeWidthTable.IO
5558import Graphics.Vty.UnicodeWidthTable.Install
5659
60+import Data.Char (isPrint, showLitChar)
61+import qualified Data.ByteString.Char8 as BS8
62+
5763import qualified Control.Exception as E
5864import Control.Monad (when)
5965import Control.Concurrent.STM
@@ -162,7 +168,7 @@ internalMkVty :: Input -> Output -> IO Vty
162168internalMkVty input out = do
163169 reserveDisplay out
164170
165− shutdownVar <- atomically $ newTVar False
171+ shutdownVar <- newTVarIO False
166172 let shutdownIo = do
167173 alreadyShutdown <- atomically $ swapTVar shutdownVar True
168174 when (not alreadyShutdown) $ do
@@ -170,7 +176,7 @@ internalMkVty input out = do
170176 releaseDisplay out
171177 releaseTerminal out
172178
173− let shutdownStatus = atomically $ readTVar shutdownVar
179+ let shutdownStatus = readTVarIO shutdownVar
174180
175181 lastPicRef <- newIORef Nothing
176182 lastUpdateRef <- newIORef Nothing
@@ -204,16 +210,18 @@ internalMkVty input out = do
204210 maybe (return ()) innerUpdate mPic
205211
206212 let mkResize = uncurry EvResize <$> displayBounds out
213+
214+ translateInternalEvent ResumeAfterSignal = mkResize
215+ translateInternalEvent (InputEvent e) = return e
216+
207217 gkey = do
208− k <- atomically $ readTChan $ _eventChannel input
209− case k of
210− (EvResize _ _) -> mkResize
211− _ -> return k
218+ e <- atomically $ readTChan $ _eventChannel input
219+ translateInternalEvent e
212220 gkey' = do
213− k <- atomically $ tryReadTChan $ _eventChannel input
214− case k of
215− (Just (EvResize _ _)) -> Just <$> mkResize
216− _ -> return k
221+ mEv <- atomically $ tryReadTChan $ _eventChannel input
222+ case mEv of
223+ Just e -> Just <$> translateInternalEvent e
224+ Nothing -> return Nothing
217225
218226 return $ Vty { update = innerUpdate
219227 , nextEvent = gkey
@@ -224,3 +232,24 @@ internalMkVty input out = do
224232 , shutdown = shutdownIo
225233 , isShutdown = shutdownStatus
226234 }
235+
236+-- | Set the terminal window title string.
237+--
238+-- This function emits an Xterm-compatible escape sequence that we
239+-- anticipate will work for essentially all modern terminal emulators.
240+-- Ideally we'd use a terminal capability for this, but there does not
241+-- seem to exist a termcap for setting window titles. If you find that
242+-- this function does not work for a given terminal emulator, please
243+-- report the issue.
244+--
245+-- For details, see:
246+--
247+-- https://tldp.org/HOWTO/Xterm-Title-3.html
248+setWindowTitle :: Vty -> String -> IO ()
249+setWindowTitle vty title = do
250+ let sanitize :: String -> String
251+ sanitize = concatMap sanitizeChar
252+ sanitizeChar c | not (isPrint c) = showLitChar c ""
253+ | otherwise = [c]
254+ let buf = BS8.pack $ "\ESC]2;" <> sanitize title <> "\007"
255+ outputByteBuffer (outputIface vty) buf
src/Graphics/Vty/Attributes.hs+8−46
@@ -1,7 +1,4 @@
11{-# LANGUAGE CPP #-}
2−{-# LANGUAGE StandaloneDeriving #-}
3−{-# LANGUAGE GADTs #-}
4−{-# LANGUAGE RankNTypes #-}
52{-# LANGUAGE DeriveGeneric #-}
63{-# LANGUAGE DeriveAnyClass #-}
74
@@ -43,6 +40,7 @@ module Graphics.Vty.Attributes
4340 , withStyle
4441 , standout
4542 , italic
43+ , strikethrough
4644 , underline
4745 , reverseVideo
4846 , blink
@@ -63,9 +61,6 @@ where
6361
6462import Control.DeepSeq
6563import Data.Bits
66−#if !(MIN_VERSION_base(4,11,0))
67−import Data.Semigroup
68−#endif
6964import Data.Text (Text)
7065import Data.Word
7166import GHC.Generics
@@ -118,19 +113,6 @@ data Attr = Attr
118113-- Then the foreground color encoded into 8 bits.
119114-- Then the background color encoded into 8 bits.
120115
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−
134116-- | Specifies the display attributes such that the final style and
135117-- color values do not depend on the previously applied display
136118-- attribute. The display attributes can still depend on the terminal's
@@ -145,43 +127,20 @@ data FixedAttr = FixedAttr
145127-- | The style and color attributes can either be the terminal defaults.
146128-- Or be equivalent to the previously applied style. Or be a specific
147129-- value.
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
130+data MaybeDefault v = Default | KeepCurrent | SetTo !v
131+ deriving (Eq, Read, Show)
152132
153133instance (NFData v) => NFData (MaybeDefault v) where
154134 rnf Default = ()
155135 rnf KeepCurrent = ()
156136 rnf (SetTo v) = rnf v
157137
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−
179138-- | Styles are represented as an 8 bit word. Each bit in the word is 1
180139-- if the style attribute assigned to that bit should be applied and 0
181140-- if the style attribute should not be applied.
182141type Style = Word8
183142
184−-- | The 7 possible style attributes:
143+-- | Valid style attributes include:
185144--
186145-- * standout
187146--
@@ -197,9 +156,11 @@ type Style = Word8
197156--
198157-- * italic
199158--
159+-- * strikethrough (via the smxx/rmxx terminfo capabilities)
160+--
200161-- (The invisible, protect, and altcharset display attributes some
201162-- terminals support are not supported via VTY.)
202−standout, underline, reverseVideo, blink, dim, bold, italic :: Style
163+standout, underline, reverseVideo, blink, dim, bold, italic, strikethrough :: Style
203164standout = 0x01
204165underline = 0x02
205166reverseVideo = 0x04
@@ -207,6 +168,7 @@ blink = 0x08
207168dim = 0x10
208169bold = 0x20
209170italic = 0x40
171+strikethrough = 0x80
210172
211173defaultStyleMask :: Style
212174defaultStyleMask = 0x00
src/Graphics/Vty/Attributes/Color.hs+67−3
@@ -1,8 +1,14 @@
11{-# LANGUAGE DeriveGeneric #-}
22{-# LANGUAGE DeriveAnyClass #-}
3+{-# LANGUAGE MultiWayIf #-}
4+{-# LANGUAGE ScopedTypeVariables #-}
35
46module Graphics.Vty.Attributes.Color
57 ( Color(..)
8+ , ColorMode(..)
9+
10+ -- * Detecting Terminal Color Support
11+ , detectColorMode
612
713 -- ** Fixed Colors
814 -- | Standard 8-color ANSI terminal color codes.
@@ -32,7 +38,10 @@ module Graphics.Vty.Attributes.Color
3238 , brightCyan
3339 , brightWhite
3440 -- ** Creating Colors From RGB
41+ , linearColor
42+ , srgbColor
3543 , rgbColor
44+ , color240
3645 , module Graphics.Vty.Attributes.Color240
3746 )
3847where
@@ -40,6 +49,11 @@ where
4049import Data.Word
4150import GHC.Generics
4251import 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
4357
4458import Graphics.Vty.Attributes.Color240
4559
@@ -81,7 +95,7 @@ import Graphics.Vty.Attributes.Color240
8195-- reported then the color reproduction will be incorrect.
8296--
8397-- If the terminal reports <= 16 colors then the 240 color palette
84−-- points are only mapped to the 8 color pallete. I'm not sure of
98+-- points are only mapped to the 8 color palette. I'm not sure of
8599-- the RGB points for the "bright" colors which is why they are not
86100-- addressable via the 240 color palette.
87101--
@@ -95,9 +109,33 @@ import Graphics.Vty.Attributes.Color240
95109-- terminfo but I don't know it.
96110--
97111-- Seriously, terminal color support is INSANE.
98−data Color = ISOColor !Word8 | Color240 !Word8
112+data Color = ISOColor !Word8 | Color240 !Word8 | RGBColor !Word8 !Word8 !Word8
99113 deriving ( Eq, Show, Read, Generic, NFData )
100114
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+
101139black, red, green, yellow, blue, magenta, cyan, white :: Color
102140black = ISOColor 0
103141red = ISOColor 1
@@ -119,9 +157,35 @@ brightMagenta= ISOColor 13
119157brightCyan = ISOColor 14
120158brightWhite = ISOColor 15
121159
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)
122186
123187-- | Create a Vty 'Color' (in the 240 color set) from an RGB triple.
124188-- This function is lossy in the sense that we only internally support 240 colors but the
125189-- #RRGGBB format supports 16^3 colors.
126190rgbColor :: Integral i => i -> i -> i -> Color
127−rgbColor r g b = Color240 (rgbColorToColor240 r g b)
191+rgbColor = color240
src/Graphics/Vty/Attributes/Color240.hs+10−218
@@ -39,226 +39,18 @@ rgbColorToColor240 r g b
3939 | r == 218 && g == 218 && b == 218 = 237
4040 | r == 228 && g == 228 && b == 228 = 238
4141 | r == 238 && g == 238 && b == 238 = 239
42− | r <= 0 && g <= 0 && b <= 0 = 0
43− | r <= 0 && g <= 0 && b <= 95 = 1
44− | r <= 0 && g <= 0 && b <= 135 = 2
45− | r <= 0 && g <= 0 && b <= 175 = 3
46− | r <= 0 && g <= 0 && b <= 215 = 4
47− | r <= 0 && g <= 0 && b <= 255 = 5
48− | r <= 0 && g <= 95 && b <= 0 = 6
49− | r <= 0 && g <= 95 && b <= 95 = 7
50− | r <= 0 && g <= 95 && b <= 135 = 8
51− | r <= 0 && g <= 95 && b <= 175 = 9
52− | r <= 0 && g <= 95 && b <= 215 = 10
53− | r <= 0 && g <= 95 && b <= 255 = 11
54− | r <= 0 && g <= 135 && b <= 0 = 12
55− | r <= 0 && g <= 135 && b <= 95 = 13
56− | r <= 0 && g <= 135 && b <= 135 = 14
57− | r <= 0 && g <= 135 && b <= 175 = 15
58− | r <= 0 && g <= 135 && b <= 215 = 16
59− | r <= 0 && g <= 135 && b <= 255 = 17
60− | r <= 0 && g <= 175 && b <= 0 = 18
61− | r <= 0 && g <= 175 && b <= 95 = 19
62− | r <= 0 && g <= 175 && b <= 135 = 20
63− | r <= 0 && g <= 175 && b <= 175 = 21
64− | r <= 0 && g <= 175 && b <= 215 = 22
65− | r <= 0 && g <= 175 && b <= 255 = 23
66− | r <= 0 && g <= 215 && b <= 0 = 24
67− | r <= 0 && g <= 215 && b <= 95 = 25
68− | r <= 0 && g <= 215 && b <= 135 = 26
69− | r <= 0 && g <= 215 && b <= 175 = 27
70− | r <= 0 && g <= 215 && b <= 215 = 28
71− | r <= 0 && g <= 215 && b <= 255 = 29
72− | r <= 0 && g <= 255 && b <= 0 = 30
73− | r <= 0 && g <= 255 && b <= 95 = 31
74− | r <= 0 && g <= 255 && b <= 135 = 32
75− | r <= 0 && g <= 255 && b <= 175 = 33
76− | r <= 0 && g <= 255 && b <= 215 = 34
77− | r <= 0 && g <= 255 && b <= 255 = 35
78− | r <= 95 && g <= 0 && b <= 0 = 36
79− | r <= 95 && g <= 0 && b <= 95 = 37
80− | r <= 95 && g <= 0 && b <= 135 = 38
81− | r <= 95 && g <= 0 && b <= 175 = 39
82− | r <= 95 && g <= 0 && b <= 215 = 40
83− | r <= 95 && g <= 0 && b <= 255 = 41
84− | r <= 95 && g <= 95 && b <= 0 = 42
85− | r <= 95 && g <= 95 && b <= 95 = 43
86− | r <= 95 && g <= 95 && b <= 135 = 44
87− | r <= 95 && g <= 95 && b <= 175 = 45
88− | r <= 95 && g <= 95 && b <= 215 = 46
89− | r <= 95 && g <= 95 && b <= 255 = 47
90− | r <= 95 && g <= 135 && b <= 0 = 48
91− | r <= 95 && g <= 135 && b <= 95 = 49
92− | r <= 95 && g <= 135 && b <= 135 = 50
93− | r <= 95 && g <= 135 && b <= 175 = 51
94− | r <= 95 && g <= 135 && b <= 215 = 52
95− | r <= 95 && g <= 135 && b <= 255 = 53
96− | r <= 95 && g <= 175 && b <= 0 = 54
97− | r <= 95 && g <= 175 && b <= 95 = 55
98− | r <= 95 && g <= 175 && b <= 135 = 56
99− | r <= 95 && g <= 175 && b <= 175 = 57
100− | r <= 95 && g <= 175 && b <= 215 = 58
101− | r <= 95 && g <= 175 && b <= 255 = 59
102− | r <= 95 && g <= 215 && b <= 0 = 60
103− | r <= 95 && g <= 215 && b <= 95 = 61
104− | r <= 95 && g <= 215 && b <= 135 = 62
105− | r <= 95 && g <= 215 && b <= 175 = 63
106− | r <= 95 && g <= 215 && b <= 215 = 64
107− | r <= 95 && g <= 215 && b <= 255 = 65
108− | r <= 95 && g <= 255 && b <= 0 = 66
109− | r <= 95 && g <= 255 && b <= 95 = 67
110− | r <= 95 && g <= 255 && b <= 135 = 68
111− | r <= 95 && g <= 255 && b <= 175 = 69
112− | r <= 95 && g <= 255 && b <= 215 = 70
113− | r <= 95 && g <= 255 && b <= 255 = 71
114− | r <= 135 && g <= 0 && b <= 0 = 72
115− | r <= 135 && g <= 0 && b <= 95 = 73
116− | r <= 135 && g <= 0 && b <= 135 = 74
117− | r <= 135 && g <= 0 && b <= 175 = 75
118− | r <= 135 && g <= 0 && b <= 215 = 76
119− | r <= 135 && g <= 0 && b <= 255 = 77
120− | r <= 135 && g <= 95 && b <= 0 = 78
121− | r <= 135 && g <= 95 && b <= 95 = 79
122− | r <= 135 && g <= 95 && b <= 135 = 80
123− | r <= 135 && g <= 95 && b <= 175 = 81
124− | r <= 135 && g <= 95 && b <= 215 = 82
125− | r <= 135 && g <= 95 && b <= 255 = 83
126− | r <= 135 && g <= 135 && b <= 0 = 84
127− | r <= 135 && g <= 135 && b <= 95 = 85
128− | r <= 135 && g <= 135 && b <= 135 = 86
129− | r <= 135 && g <= 135 && b <= 175 = 87
130− | r <= 135 && g <= 135 && b <= 215 = 88
131− | r <= 135 && g <= 135 && b <= 255 = 89
132− | r <= 135 && g <= 175 && b <= 0 = 90
133− | r <= 135 && g <= 175 && b <= 95 = 91
134− | r <= 135 && g <= 175 && b <= 135 = 92
135− | r <= 135 && g <= 175 && b <= 175 = 93
136− | r <= 135 && g <= 175 && b <= 215 = 94
137− | r <= 135 && g <= 175 && b <= 255 = 95
138− | r <= 135 && g <= 215 && b <= 0 = 96
139− | r <= 135 && g <= 215 && b <= 95 = 97
140− | r <= 135 && g <= 215 && b <= 135 = 98
141− | r <= 135 && g <= 215 && b <= 175 = 99
142− | r <= 135 && g <= 215 && b <= 215 = 100
143− | r <= 135 && g <= 215 && b <= 255 = 101
144− | r <= 135 && g <= 255 && b <= 0 = 102
145− | r <= 135 && g <= 255 && b <= 95 = 103
146− | r <= 135 && g <= 255 && b <= 135 = 104
147− | r <= 135 && g <= 255 && b <= 175 = 105
148− | r <= 135 && g <= 255 && b <= 215 = 106
149− | r <= 135 && g <= 255 && b <= 255 = 107
150− | r <= 175 && g <= 0 && b <= 0 = 108
151− | r <= 175 && g <= 0 && b <= 95 = 109
152− | r <= 175 && g <= 0 && b <= 135 = 110
153− | r <= 175 && g <= 0 && b <= 175 = 111
154− | r <= 175 && g <= 0 && b <= 215 = 112
155− | r <= 175 && g <= 0 && b <= 255 = 113
156− | r <= 175 && g <= 95 && b <= 0 = 114
157− | r <= 175 && g <= 95 && b <= 95 = 115
158− | r <= 175 && g <= 95 && b <= 135 = 116
159− | r <= 175 && g <= 95 && b <= 175 = 117
160− | r <= 175 && g <= 95 && b <= 215 = 118
161− | r <= 175 && g <= 95 && b <= 255 = 119
162− | r <= 175 && g <= 135 && b <= 0 = 120
163− | r <= 175 && g <= 135 && b <= 95 = 121
164− | r <= 175 && g <= 135 && b <= 135 = 122
165− | r <= 175 && g <= 135 && b <= 175 = 123
166− | r <= 175 && g <= 135 && b <= 215 = 124
167− | r <= 175 && g <= 135 && b <= 255 = 125
168− | r <= 175 && g <= 175 && b <= 0 = 126
169− | r <= 175 && g <= 175 && b <= 95 = 127
170− | r <= 175 && g <= 175 && b <= 135 = 128
171− | r <= 175 && g <= 175 && b <= 175 = 129
172− | r <= 175 && g <= 175 && b <= 215 = 130
173− | r <= 175 && g <= 175 && b <= 255 = 131
174− | r <= 175 && g <= 215 && b <= 0 = 132
175− | r <= 175 && g <= 215 && b <= 95 = 133
176− | r <= 175 && g <= 215 && b <= 135 = 134
177− | r <= 175 && g <= 215 && b <= 175 = 135
178− | r <= 175 && g <= 215 && b <= 215 = 136
179− | r <= 175 && g <= 215 && b <= 255 = 137
180− | r <= 175 && g <= 255 && b <= 0 = 138
181− | r <= 175 && g <= 255 && b <= 95 = 139
182− | r <= 175 && g <= 255 && b <= 135 = 140
183− | r <= 175 && g <= 255 && b <= 175 = 141
184− | r <= 175 && g <= 255 && b <= 215 = 142
185− | r <= 175 && g <= 255 && b <= 255 = 143
186− | r <= 215 && g <= 0 && b <= 0 = 144
187− | r <= 215 && g <= 0 && b <= 95 = 145
188− | r <= 215 && g <= 0 && b <= 135 = 146
189− | r <= 215 && g <= 0 && b <= 175 = 147
190− | r <= 215 && g <= 0 && b <= 215 = 148
191− | r <= 215 && g <= 0 && b <= 255 = 149
192− | r <= 215 && g <= 95 && b <= 0 = 150
193− | r <= 215 && g <= 95 && b <= 95 = 151
194− | r <= 215 && g <= 95 && b <= 135 = 152
195− | r <= 215 && g <= 95 && b <= 175 = 153
196− | r <= 215 && g <= 95 && b <= 215 = 154
197− | r <= 215 && g <= 95 && b <= 255 = 155
198− | r <= 215 && g <= 135 && b <= 0 = 156
199− | r <= 215 && g <= 135 && b <= 95 = 157
200− | r <= 215 && g <= 135 && b <= 135 = 158
201− | r <= 215 && g <= 135 && b <= 175 = 159
202− | r <= 215 && g <= 135 && b <= 215 = 160
203− | r <= 215 && g <= 135 && b <= 255 = 161
204− | r <= 215 && g <= 175 && b <= 0 = 162
205− | r <= 215 && g <= 175 && b <= 95 = 163
206− | r <= 215 && g <= 175 && b <= 135 = 164
207− | r <= 215 && g <= 175 && b <= 175 = 165
208− | r <= 215 && g <= 175 && b <= 215 = 166
209− | r <= 215 && g <= 175 && b <= 255 = 167
210− | r <= 215 && g <= 215 && b <= 0 = 168
211− | r <= 215 && g <= 215 && b <= 95 = 169
212− | r <= 215 && g <= 215 && b <= 135 = 170
213− | r <= 215 && g <= 215 && b <= 175 = 171
214− | r <= 215 && g <= 215 && b <= 215 = 172
215− | r <= 215 && g <= 215 && b <= 255 = 173
216− | r <= 215 && g <= 255 && b <= 0 = 174
217− | r <= 215 && g <= 255 && b <= 95 = 175
218− | r <= 215 && g <= 255 && b <= 135 = 176
219− | r <= 215 && g <= 255 && b <= 175 = 177
220− | r <= 215 && g <= 255 && b <= 215 = 178
221− | r <= 215 && g <= 255 && b <= 255 = 179
222− | r <= 255 && g <= 0 && b <= 0 = 180
223− | r <= 255 && g <= 0 && b <= 95 = 181
224− | r <= 255 && g <= 0 && b <= 135 = 182
225− | r <= 255 && g <= 0 && b <= 175 = 183
226− | r <= 255 && g <= 0 && b <= 215 = 184
227− | r <= 255 && g <= 0 && b <= 255 = 185
228− | r <= 255 && g <= 95 && b <= 0 = 186
229− | r <= 255 && g <= 95 && b <= 95 = 187
230− | r <= 255 && g <= 95 && b <= 135 = 188
231− | r <= 255 && g <= 95 && b <= 175 = 189
232− | r <= 255 && g <= 95 && b <= 215 = 190
233− | r <= 255 && g <= 95 && b <= 255 = 191
234− | r <= 255 && g <= 135 && b <= 0 = 192
235− | r <= 255 && g <= 135 && b <= 95 = 193
236− | r <= 255 && g <= 135 && b <= 135 = 194
237− | r <= 255 && g <= 135 && b <= 175 = 195
238− | r <= 255 && g <= 135 && b <= 215 = 196
239− | r <= 255 && g <= 135 && b <= 255 = 197
240− | r <= 255 && g <= 175 && b <= 0 = 198
241− | r <= 255 && g <= 175 && b <= 95 = 199
242− | r <= 255 && g <= 175 && b <= 135 = 200
243− | r <= 255 && g <= 175 && b <= 175 = 201
244− | r <= 255 && g <= 175 && b <= 215 = 202
245− | r <= 255 && g <= 175 && b <= 255 = 203
246− | r <= 255 && g <= 215 && b <= 0 = 204
247− | r <= 255 && g <= 215 && b <= 95 = 205
248− | r <= 255 && g <= 215 && b <= 135 = 206
249− | r <= 255 && g <= 215 && b <= 175 = 207
250− | r <= 255 && g <= 215 && b <= 215 = 208
251− | r <= 255 && g <= 215 && b <= 255 = 209
252− | r <= 255 && g <= 255 && b <= 0 = 210
253− | r <= 255 && g <= 255 && b <= 95 = 211
254− | r <= 255 && g <= 255 && b <= 135 = 212
255− | r <= 255 && g <= 255 && b <= 175 = 213
256− | r <= 255 && g <= 255 && b <= 215 = 214
257− | r <= 255 && g <= 255 && b <= 255 = 215
258− | otherwise = error (printf "RGB color %d %d %d does not map to 240 palette."
42+ | otherwise = 36 * go r + 6 * go g + go b
43+ where go = simpleColor_ (error (printf "RGB color %d %d %d does not map to 240 palette."
25944 (fromIntegral r :: Int)
26045 (fromIntegral g :: Int)
261− (fromIntegral b :: Int))
46+ (fromIntegral b :: Int)))
47+
48+simpleColor_ :: Integral i => Word8 -> i -> Word8
49+simpleColor_ e c
50+ | c <= 0 = 0
51+ | c <= 95 = 1
52+ | c <= 255 = fromIntegral ((c-16) `div` 40)
53+ | otherwise = e
26254
26355-- | Create a RGB triple from a value in the Color240 set.
26456color240CodeToRGB :: Word8 -> Maybe (Int, Int, Int)
src/Graphics/Vty/Config.hs+11−2
@@ -3,6 +3,7 @@
33{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}
44{-# LANGUAGE TypeOperators #-}
55{-# LANGUAGE ScopedTypeVariables #-}
6+{-# LANGUAGE LambdaCase, MultiWayIf #-}
67-- | Vty supports a configuration file format and associated 'Config'
78-- data type. The 'Config' can be provided to 'mkVty' to customize the
89-- application's use of Vty.
@@ -54,7 +55,7 @@
5455-- If a debug log is requested then vty will output the current input
5556-- table to the log in the above format. A workflow for using this is
5657-- to set @VTY_DEBUG_LOG@. Run the application. Check the debug log for
57−-- incorrect mappings. Add corrected mappings to @$HOME/.vty/config@.
58+-- incorrect mappings. Add corrected mappings to @$HOME\/.vty\/config@.
5859--
5960-- = Unicode Character Width Maps
6061--
@@ -122,6 +123,7 @@ import Data.Semigroup (Semigroup(..))
122123import Data.Typeable (Typeable)
123124
124125import Graphics.Vty.Input.Events
126+import Graphics.Vty.Attributes.Color (ColorMode(..), detectColorMode)
125127
126128import GHC.Generics
127129
@@ -193,6 +195,9 @@ data Config =
193195 -- configuration specifies one. If no custom table is loaded
194196 -- (or if a load fails), the built-in character width table
195197 -- will be used.
198+ , colorMode :: Maybe ColorMode
199+ -- ^ The color mode used to know how many colors the terminal
200+ -- supports.
196201 }
197202 deriving (Show, Eq)
198203
@@ -214,6 +219,7 @@ instance Semigroup Config where
214219 , termWidthMaps = termWidthMaps c1 <|> termWidthMaps c0
215220 , allowCustomUnicodeWidthTables =
216221 allowCustomUnicodeWidthTables c1 <|> allowCustomUnicodeWidthTables c0
222+ , colorMode = colorMode c1 <|> colorMode c0
217223 }
218224
219225instance Monoid Config where
@@ -229,6 +235,7 @@ instance Monoid Config where
229235 , termName = Nothing
230236 , termWidthMaps = []
231237 , allowCustomUnicodeWidthTables = Nothing
238+ , colorMode = Nothing
232239 }
233240#if !(MIN_VERSION_base(4,11,0))
234241 mappend = (<>)
@@ -284,7 +291,8 @@ standardIOConfig = do
284291 mb <- lookupEnv termVariable
285292 case mb of
286293 Nothing -> throwIO VtyMissingTermEnvVar
287− Just t ->
294+ Just t -> do
295+ mcolorMode <- detectColorMode t
288296 return defaultConfig
289297 { vmin = Just 1
290298 , mouseMode = Just False
@@ -293,6 +301,7 @@ standardIOConfig = do
293301 , inputFd = Just stdInput
294302 , outputFd = Just stdOutput
295303 , termName = Just t
304+ , colorMode = Just mcolorMode
296305 }
297306
298307parseConfigFile :: FilePath -> IO Config
src/Graphics/Vty/DisplayAttributes.hs+3
@@ -96,6 +96,8 @@ data StyleStateChange
9696 | RemoveStandout
9797 | ApplyItalic
9898 | RemoveItalic
99+ | ApplyStrikethrough
100+ | RemoveStrikethrough
99101 | ApplyUnderline
100102 | RemoveUnderline
101103 | ApplyReverseVideo
@@ -144,6 +146,7 @@ diffStyles prev cur
144146 [ styleDiff standout ApplyStandout RemoveStandout
145147 , styleDiff underline ApplyUnderline RemoveUnderline
146148 , styleDiff italic ApplyItalic RemoveItalic
149+ , styleDiff strikethrough ApplyStrikethrough RemoveStrikethrough
147150 , styleDiff reverseVideo ApplyReverseVideo RemoveReverseVideo
148151 , styleDiff blink ApplyBlink RemoveBlink
149152 , styleDiff dim ApplyDim RemoveDim
src/Graphics/Vty/Image.hs+11−10
@@ -1,5 +1,4 @@
11-- Copyright 2009-2010 Corey O'Connor
2−{-# LANGUAGE BangPatterns #-}
32{-# LANGUAGE NamedFieldPuns #-}
43{-# LANGUAGE DisambiguateRecordFields #-}
54-- | A Vty program makes 'Picture's from 'Image's. This module provides
@@ -117,14 +116,16 @@ horizCat = foldr horizJoin EmptyImage
117116vertCat :: [Image] -> Image
118117vertCat = foldr vertJoin EmptyImage
119118
120−-- | Make an 'Image' from a lazy text value. This function should not be
121−-- given a text value containing escapes.
119+-- | Make an 'Image' from a lazy text value. The text value should be
120+-- sanitized of escape sequences (ASCII 27) and carriage returns;
121+-- otherwise layout and attribute problems may result.
122122text :: Attr -> TL.Text -> Image
123123text a txt = let displayWidth = safeWctlwidth txt
124124 in HorizText a txt displayWidth (fromIntegral $! TL.length txt)
125125
126−-- | Make an 'Image' from a text value. This function should not be
127−-- given a text value containing escapes.
126+-- | Make an 'Image' from a text value. The text value should be
127+-- sanitized of escape sequences (ASCII 27) and carriage returns;
128+-- otherwise layout and attribute problems may result.
128129text' :: Attr -> T.Text -> Image
129130text' a txt = let displayWidth = safeWctwidth txt
130131 in HorizText a (TL.fromStrict txt) displayWidth (T.length txt)
@@ -136,10 +137,11 @@ char a c =
136137 let displayWidth = safeWcwidth c
137138 in HorizText a (TL.singleton c) displayWidth 1
138139
139−-- | Make an image from a string of characters layed out on a single
140+-- | Make an image from a string of characters laid out on a single
140141-- row with the same display attribute. The string is assumed to be a
141−-- sequence of ISO-10646 characters. This function should not be given a
142−-- string containing escapes.
142+-- sequence of ISO-10646 characters. The input string should be
143+-- sanitized of escape sequences (ASCII 27) and carriage returns;
144+-- otherwise layout and attribute problems may result.
143145--
144146-- Note: depending on how the Haskell compiler represents string
145147-- literals, a string literal in a UTF-8 encoded source file, for
@@ -156,8 +158,7 @@ iso10646String a str =
156158--
157159-- This is an alias for iso10646String since the usual case is that a
158160-- literal string like "foo" is represented internally as a list of ISO
159−-- 10646 31 bit characters. This function should not be given a string
160−-- containing escapes.
161+-- 10646 31 bit characters.
161162--
162163-- Note: Keep in mind that GHC will compile source encoded as UTF-8
163164-- but the literal strings, while UTF-8 encoded in the source, will be
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 inImg = go 0 inImg
149+ppImageStructure = go 0
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 missmatch
231+-- images. The area not defined in one image due to a height mismatch
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 missmatch
262+-- images. The area not defined in one image due to a width mismatch
263263-- will be filled with the background pattern.
264264vertJoin :: Image -> Image -> Image
265265vertJoin EmptyImage i = i
src/Graphics/Vty/Inline.hs+5−7
@@ -1,5 +1,3 @@
1−{-# LANGUAGE BangPatterns #-}
2−
31-- | The inline module provides a limited interface to changing the
42-- style of terminal output. The intention is for this interface to be
53-- used inline with other output systems.
@@ -58,13 +56,13 @@ data InlineState =
5856-- | Set the background color to the provided 'Color'.
5957backColor :: Color -> InlineM ()
6058backColor c = modify $ \s ->
61− s { inlineAttr = inlineAttr s `mappend` (currentAttr `withBackColor` c)
59+ s { inlineAttr = inlineAttr s `withBackColor` c
6260 }
6361
6462-- | Set the foreground color to the provided 'Color'.
6563foreColor :: Color -> InlineM ()
6664foreColor c = modify $ \s ->
67− s { inlineAttr = inlineAttr s `mappend` (currentAttr `withForeColor` c)
65+ s { inlineAttr = inlineAttr s `withForeColor` c
6866 }
6967
7068-- | Attempt to change the 'Style' of the following text..
@@ -73,7 +71,7 @@ foreColor c = modify $ \s ->
7371-- produced. The style can still be removed.
7472applyStyle :: Style -> InlineM ()
7573applyStyle st = modify $ \s ->
76− s { inlineAttr = inlineAttr s `mappend` (currentAttr `withStyle` st)
74+ s { inlineAttr = inlineAttr s `withStyle` st
7775 }
7876
7977-- | Attempt to remove the specified 'Style' from the display of the
@@ -85,8 +83,8 @@ removeStyle :: Style -> InlineM ()
8583removeStyle sMask = modify $ \s ->
8684 s { inlineAttr =
8785 let style' = case attrStyle (inlineAttr s) of
88− Default -> error $ "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."
89− KeepCurrent -> error $ "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."
86+ Default -> error "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."
87+ KeepCurrent -> error "Graphics.Vty.Inline: Cannot removeStyle if applyStyle never used."
9088 SetTo st -> st .&. complement sMask
9189 in (inlineAttr s) { attrStyle = SetTo style' }
9290 }
src/Graphics/Vty/Input.hs+11−22
@@ -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 unambiguiously. UTF-8 input is
80+-- * 7-bit mode: UTF-8 can be input unambiguously. 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 fundemental issues. There is no easy way
98+-- Clearly terminal input has fundamental issues. There is no easy way
9999-- to reliably resolve these issues.
100100--
101101-- One resolution would be to ditch standard terminal interfaces
@@ -143,22 +143,8 @@ import Data.Monoid ((<>))
143143-- bytes comes from 'classifyMapForTerm' which is then overridden by
144144-- the the applicable entries from the configuration's 'inputMap'.
145145--
146−-- The terminal device is configured with the attributes:
147−--
148−-- * IXON disabled: disables software flow control on outgoing data.
149−-- This stops the process from being suspended if the output terminal
150−-- cannot keep up.
151−--
152−-- * Raw mode is used for input.
153−--
154−-- * ISIG disabled (enables keyboard combinations that result in
155−-- signals)
156−--
157−-- * ECHO disabled (input is not echoed to the output)
158−--
159−-- * ICANON disabled (canonical mode (line mode) input is not used)
160−--
161−-- * IEXTEN disabled (extended functions are disabled)
146+-- The terminal device's mode flags are configured by the
147+-- 'attributeControl' function.
162148inputForConfig :: Config -> IO Input
163149inputForConfig config@Config{ termName = Just termName
164150 , inputFd = Just termFd
@@ -168,20 +154,23 @@ inputForConfig config@Config{ termName = Just termName
168154 terminal <- Terminfo.setupTerm termName
169155 let inputOverrides = [(s,e) | (t,s,e) <- inputMap, t == Nothing || t == Just termName]
170156 activeInputMap = classifyMapForTerm termName terminal `mappend` inputOverrides
171− (setAttrs,unsetAttrs) <- attributeControl termFd
157+ (setAttrs, unsetAttrs) <- attributeControl termFd
172158 setAttrs
173159 input <- initInput config activeInputMap
174160 let pokeIO = Catch $ do
175− let e = error "vty internal failure: this value should not propagate to users"
176161 setAttrs
177− atomically $ writeTChan (input^.eventChannel) (EvResize e e)
162+ atomically $ writeTChan (input^.eventChannel) ResumeAfterSignal
178163 _ <- installHandler windowChange pokeIO Nothing
179164 _ <- installHandler continueProcess pokeIO Nothing
165+
166+ let restore = unsetAttrs
167+
180168 return $ input
181169 { shutdownInput = do
182170 shutdownInput input
183171 _ <- installHandler windowChange Ignore Nothing
184172 _ <- installHandler continueProcess Ignore Nothing
185− unsetAttrs
173+ restore
174+ , restoreInputState = restoreInputState input >> restore
186175 }
187176inputForConfig config = (<> config) <$> standardIOConfig >>= inputForConfig
src/Graphics/Vty/Input/Classify.hs+53−29
@@ -1,10 +1,11 @@
11{-# OPTIONS_HADDOCK hide #-}
2−-- This makes a kind of tri. Has space efficiency issues with large
2+-- This makes a kind of trie. 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(..)
89 )
910where
1011
@@ -16,25 +17,39 @@ import Graphics.Vty.Input.Classify.Types
1617
1718import Codec.Binary.UTF8.Generic (decode)
1819
19−import Data.List (inits)
20+import Control.Arrow (first)
2021import qualified Data.Map as M( fromList, lookup )
2122import Data.Maybe ( mapMaybe )
2223import qualified Data.Set as S( fromList, member )
2324
24−import Data.Char
2525import Data.Word
2626
27−compile :: ClassifyMap -> [Char] -> KClass
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
2843compile table = cl' where
2944 -- take all prefixes and create a set of these
30− prefixSet = S.fromList $ concatMap (init . inits . fst) $ table
45+ prefixSet = S.fromList $ concatMap (init . BS.inits . BS8.pack . fst) table
3146 maxValidInputLength = maximum (map (length . fst) table)
32− eventForInput = M.fromList table
33− cl' [] = Prefix
47+ eventForInput = M.fromList $ map (first BS8.pack) table
48+ cl' inputBlock | BS8.null inputBlock = Prefix
3449 cl' inputBlock = case M.lookup inputBlock eventForInput of
3550 -- if the inputBlock is exactly what is expected for an
3651 -- event then consume the whole block and return the event
37− Just e -> Valid e []
52+ Just e -> Valid e BS8.empty
3853 Nothing -> case S.member inputBlock prefixSet of
3954 True -> Prefix
4055 -- look up progressively smaller tails of the input
@@ -45,40 +60,49 @@ compile table = cl' where
4560 -- H: There will always be one match. The prefixSet
4661 -- contains, by definition, all prefixes of an event.
4762 False ->
48− let inputPrefixes = reverse $ take maxValidInputLength $ tail $ inits inputBlock
63+ let inputPrefixes = reverse . take maxValidInputLength . tail . BS8.inits $ inputBlock
4964 in case mapMaybe (\s -> (,) s `fmap` M.lookup s eventForInput) inputPrefixes of
50− (s,e) : _ -> Valid e (drop (length s) inputBlock)
65+ (s,e) : _ -> Valid e (BS8.drop (BS8.length s) inputBlock)
5166 -- neither a prefix or a full event.
5267 [] -> Invalid
5368
54−classify :: ClassifyMap -> [Char] -> KClass
55−classify table =
56− let standardClassifier = compile table
57− in \s -> case s of
58− _ | bracketedPasteStarted s ->
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 =
5986 if bracketedPasteFinished s
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
87+ then parseBracketedPaste $ BS.concat $ p:reverse (s:ps)
88+ else Chunk
89+ process ClassifierInChunk{} _ = Invalid
6690
67−classifyUtf8 :: Char -> [Char] -> KClass
91+classifyUtf8 :: Word8 -> ByteString -> KClass
6892classifyUtf8 c cs =
69− let n = utf8Length (ord c)
70− (codepoint,rest) = splitAt n (c:cs)
93+ let n = utf8Length c
94+ (codepoint,rest) = BS8.splitAt (n - 1) cs
7195
7296 codepoint8 :: [Word8]
73− codepoint8 = map (fromIntegral . ord) codepoint
97+ codepoint8 = c:BS.unpack codepoint
7498
7599 in case decode codepoint8 of
76− _ | n < length codepoint -> Prefix
77− Just (unicodeChar, _) -> Valid (EvKey (KChar unicodeChar) []) rest
100+ _ | n < BS.length codepoint + 1 -> Prefix
101+ Just (unicodeChar, _) -> Valid (EvKey (KChar unicodeChar) []) rest
78102 -- something bad happened; just ignore and continue.
79− Nothing -> Invalid
103+ Nothing -> Invalid
80104
81−utf8Length :: (Num t, Ord a, Num a) => a -> t
105+utf8Length :: Word8 -> Int
82106utf8Length c
83107 | c < 0x80 = 1
84108 | c < 0xE0 = 2
src/Graphics/Vty/Input/Classify/Parse.hs+10−7
@@ -16,12 +16,15 @@ import Graphics.Vty.Input.Classify.Types
1616import Control.Monad.Trans.Maybe
1717import Control.Monad.State
1818
19−type Parser a = MaybeT (State String) a
19+import qualified Data.ByteString.Char8 as BS8
20+import Data.ByteString.Char8 (ByteString)
21+
22+type Parser a = MaybeT (State ByteString) a
2023
2124-- | Run a parser on a given input string. If the parser fails, return
2225-- 'Invalid'. Otherwise return the valid event ('Valid') and the
2326-- remaining unparsed characters.
24−runParser :: String -> Parser Event -> KClass
27+runParser :: ByteString -> Parser Event -> KClass
2528runParser s parser =
2629 case runState (runMaybeT parser) s of
2730 (Nothing, _) -> Invalid
@@ -36,9 +39,9 @@ failParse = fail "invalid parse"
3639-- return '123' and consume those characters.
3740readInt :: Parser Int
3841readInt = do
39− s <- get
42+ s <- BS8.unpack <$> get
4043 case (reads :: ReadS Int) s of
41− [(i, rest)] -> put rest >> return i
44+ [(i, rest)] -> put (BS8.pack rest) >> return i
4245 _ -> failParse
4346
4447-- | Read a character from the input stream. If one cannot be read (e.g.
@@ -46,9 +49,9 @@ readInt = do
4649readChar :: Parser Char
4750readChar = do
4851 s <- get
49− case s of
50− c:rest -> put rest >> return c
51− _ -> failParse
52+ case BS8.uncons s of
53+ Just (c,rest) -> put rest >> return c
54+ Nothing -> failParse
5255
5356-- | Read a character from the input stream and fail parsing if it is
5457-- not the specified character.
src/Graphics/Vty/Input/Classify/Types.hs+7−1
@@ -1,5 +1,6 @@
11-- | This module exports the input classification type to avoid import
22-- cycles between other modules that need this.
3+{-# LANGUAGE StrictData #-}
34module Graphics.Vty.Input.Classify.Types
45 ( KClass(..)
56 )
@@ -7,8 +8,10 @@ where
78
89import Graphics.Vty.Input.Events
910
11+import Data.ByteString.Char8 (ByteString)
12+
1013data KClass
11− = Valid Event [Char]
14+ = Valid Event ByteString
1215 -- ^ A valid event was parsed. Any unused characters from the input
1316 -- stream are also provided.
1417 | Invalid
@@ -16,4 +19,7 @@ data KClass
1619 | Prefix
1720 -- ^ The input characters form the prefix of a valid event character
1821 -- 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.
1925 deriving(Show, Eq)
src/Graphics/Vty/Input/Events.hs+24−6
@@ -1,6 +1,8 @@
11{-# Language DeriveGeneric #-}
2+{-# Language StrictData #-}
23module Graphics.Vty.Input.Events where
34
5+import Control.DeepSeq
46import Data.ByteString
57import GHC.Generics
68
@@ -14,23 +16,29 @@ import GHC.Generics
1416--
1517-- * Actually, support for most of these but KEsc, KChar, KBS, and
1618-- KEnter vary by terminal and keyboard.
17−data Key = KEsc | KChar Char | KBS | KEnter
19+data Key = KEsc | KChar {-# UNPACK #-} Char | KBS | KEnter
1820 | KLeft | KRight | KUp | KDown
1921 | KUpLeft | KUpRight | KDownLeft | KDownRight | KCenter
20− | KFun Int | KBackTab | KPrtScr | KPause | KIns
22+ | KFun {-# UNPACK #-} Int | KBackTab | KPrtScr | KPause | KIns
2123 | KHome | KPageUp | KDel | KEnd | KPageDown | KBegin | KMenu
2224 deriving (Eq,Show,Read,Ord,Generic)
2325
26+instance NFData Key
27+
2428-- | Modifier keys. Key codes are interpreted such that users are more
2529-- likely to have Meta than Alt; for instance on the PC Linux console,
2630-- 'MMeta' will generally correspond to the physical Alt key.
2731data Modifier = MShift | MCtrl | MMeta | MAlt
2832 deriving (Eq,Show,Read,Ord,Generic)
2933
34+instance NFData Modifier
35+
3036-- | Mouse buttons.
3137data Button = BLeft | BMiddle | BRight | BScrollUp | BScrollDown
3238 deriving (Eq,Show,Read,Ord,Generic)
3339
40+instance NFData Button
41+
3442-- | Events.
3543data Event
3644 = EvKey Key [Modifier]
@@ -44,10 +52,8 @@ data Event
4452 -- without specifying which one; in that case, Nothing is provided.
4553 -- Otherwise Just the button released is included in the event.
4654 | EvResize Int Int
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.
55+ -- The terminal window was resized and the size is provided in the
56+ -- integer fields (width, height).
5157 | EvPaste ByteString
5258 -- ^ A paste event occurs when a bracketed paste input sequence is
5359 -- received. For terminals that support bracketed paste mode, these
@@ -62,4 +68,16 @@ data Event
6268 -- ^ The terminal running the application gained input focus.
6369 deriving (Eq,Show,Read,Ord,Generic)
6470
71+instance NFData Event
72+
6573type 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+15−13
@@ -11,30 +11,32 @@ import Graphics.Vty.Input.Classify.Types
1111import Graphics.Vty.Input.Classify.Parse
1212
1313import Control.Monad.State
14−import Data.List (isPrefixOf)
14+
15+import qualified Data.ByteString.Char8 as BS8
16+import Data.ByteString.Char8 (ByteString)
1517
1618-- | These sequences set xterm-based terminals to send focus event
1719-- sequences.
18−requestFocusEvents :: String
19−requestFocusEvents = "\ESC[?1004h"
20+requestFocusEvents :: ByteString
21+requestFocusEvents = BS8.pack "\ESC[?1004h"
2022
2123-- | These sequences disable focus events.
22−disableFocusEvents :: String
23−disableFocusEvents = "\ESC[?1004l"
24+disableFocusEvents :: ByteString
25+disableFocusEvents = BS8.pack "\ESC[?1004l"
2426
2527-- | Does the specified string begin with a focus event?
26−isFocusEvent :: String -> Bool
27−isFocusEvent s = isPrefixOf focusIn s ||
28− isPrefixOf focusOut s
28+isFocusEvent :: ByteString -> Bool
29+isFocusEvent s = BS8.isPrefixOf focusIn s ||
30+ BS8.isPrefixOf focusOut s
2931
30−focusIn :: String
31−focusIn = "\ESC[I"
32+focusIn :: ByteString
33+focusIn = BS8.pack "\ESC[I"
3234
33−focusOut :: String
34−focusOut = "\ESC[O"
35+focusOut :: ByteString
36+focusOut = BS8.pack "\ESC[O"
3537
3638-- | Attempt to classify an input string as a focus event.
37−classifyFocusEvent :: String -> KClass
39+classifyFocusEvent :: ByteString -> KClass
3840classifyFocusEvent s = runParser s $ do
3941 when (not $ isFocusEvent s) failParse
4042
src/Graphics/Vty/Input/Loop.hs+86−29
@@ -1,8 +1,9 @@
1−{-# LANGUAGE RecordWildCards #-}
2−{-# OPTIONS_HADDOCK hide #-}
1+{-# LANGUAGE CPP #-}
32{-# LANGUAGE NoMonomorphismRestriction #-}
3+{-# LANGUAGE RecordWildCards #-}
4+{-# LANGUAGE ScopedTypeVariables #-}
45{-# LANGUAGE TemplateHaskell #-}
5−{-# LANGUAGE CPP #-}
6+{-# OPTIONS_HADDOCK hide #-}
67-- | The input layer used to be a single function that correctly
78-- accounted for the non-threaded runtime by emulating the terminal
89-- VMIN adn VTIME handling. This has been removed and replace with a
@@ -33,12 +34,15 @@ import Control.Monad.Trans.State (StateT(..), evalStateT)
3334import Control.Monad.State.Class (MonadState, modify)
3435import Control.Monad.Trans.Reader (ReaderT(..))
3536
36−import Data.Char
37+import qualified Data.ByteString.Char8 as BS8
38+import qualified Data.ByteString as BS
39+import Data.ByteString.Char8 (ByteString)
3740import Data.IORef
3841import Data.Word (Word8)
3942
40−import Foreign ( allocaArray, peekArray, Ptr )
43+import Foreign (allocaArray)
4144import Foreign.C.Types (CInt(..))
45+import Foreign.Ptr (Ptr, castPtr)
4246
4347import System.IO
4448import System.Posix.IO (fdReadBuf, setFdOption, FdOption(..))
@@ -51,10 +55,15 @@ data Input = Input
5155 { -- | Channel of events direct from input processing. Unlike
5256 -- 'nextEvent' this will not refresh the display if the next event
5357 -- is an 'EvResize'.
54− _eventChannel :: TChan Event
55− -- | Shuts down the input processing. This should return the
56− -- terminal input state to before he input initialized.
58+ _eventChannel :: TChan InternalEvent
59+ -- | Shuts down the input processing. As part of shutting down the
60+ -- input, this should also restore the input state.
5761 , shutdownInput :: IO ()
62+ -- | Restore the terminal's input state to what it was prior
63+ -- to configuring input for Vty. This should be done as part of
64+ -- 'shutdownInput' but is exposed in case you need to access it
65+ -- directly.
66+ , restoreInputState :: IO ()
5867 -- | Changes to this value are reflected after the next event.
5968 , _configRef :: IORef Config
6069 -- | input debug log
@@ -71,10 +80,11 @@ data InputBuffer = InputBuffer
7180makeLenses ''InputBuffer
7281
7382data InputState = InputState
74− { _unprocessedBytes :: String
83+ { _unprocessedBytes :: ByteString
84+ , _classifierState :: ClassifierState
7585 , _appliedConfig :: Config
7686 , _inputBuffer :: InputBuffer
77− , _classifier :: String -> KClass
87+ , _classifier :: ClassifierState -> ByteString -> KClass
7888 }
7989
8090makeLenses ''InputState
@@ -99,20 +109,20 @@ loopInputProcessor = do
99109 dropInvalid
100110 loopInputProcessor
101111
102−addBytesToProcess :: String -> InputM ()
112+addBytesToProcess :: ByteString -> InputM ()
103113addBytesToProcess block = unprocessedBytes <>= block
104114
105115emit :: Event -> InputM ()
106116emit event = do
107117 logMsg $ "parsed event: " ++ show event
108− view eventChannel >>= liftIO . atomically . flip writeTChan event
118+ view eventChannel >>= liftIO . atomically . flip writeTChan (InputEvent event)
109119
110120-- The timing requirements are assured by the VMIN and VTIME set for the
111121-- device.
112122--
113123-- Precondition: Under the threaded runtime. Only current use is from a
114124-- forkOS thread. That case satisfies precondition.
115−readFromDevice :: InputM String
125+readFromDevice :: InputM ByteString
116126readFromDevice = do
117127 newConfig <- view configRef >>= liftIO . readIORef
118128 oldConfig <- use appliedConfig
@@ -132,9 +142,10 @@ readFromDevice = do
132142 threadWaitRead fd
133143 bytesRead <- fdReadBuf fd bufferPtr (fromIntegral maxBytes)
134144 if bytesRead > 0
135− then fmap (map $ chr . fromIntegral) $ peekArray (fromIntegral bytesRead) bufferPtr
136− else return []
137− when (not $ null stringRep) $ logMsg $ "input bytes: " ++ show stringRep
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)
138149 return stringRep
139150
140151applyConfig :: Fd -> Config -> IO ()
@@ -145,41 +156,86 @@ applyConfig _ _ = fail "(vty) applyConfig was not provided a complete configurat
145156parseEvent :: InputM Event
146157parseEvent = do
147158 c <- use classifier
159+ s <- use classifierState
148160 b <- use unprocessedBytes
149− case c b of
161+ case c s b of
150162 Valid e remaining -> do
151163 logMsg $ "valid parse: " ++ show e
152164 logMsg $ "remaining: " ++ show remaining
165+ classifierState .= ClassifierStart
153166 unprocessedBytes .= remaining
154167 return e
155− _ -> mzero
168+ _ -> mzero
156169
157170dropInvalid :: InputM ()
158171dropInvalid = do
159172 c <- use classifier
173+ s <- use classifierState
160174 b <- use unprocessedBytes
161− when (c b == Invalid) $ do
162− logMsg "dropping input bytes"
163− 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 ()
164187
165188runInputProcessorLoop :: ClassifyMap -> Input -> IO ()
166189runInputProcessorLoop classifyTable input = do
167190 let bufferSize = 1024
168191 allocaArray bufferSize $ \(bufferPtr :: Ptr Word8) -> do
169− s0 <- InputState [] <$> readIORef (_configRef input)
170− <*> pure (InputBuffer bufferPtr bufferSize)
171− <*> pure (classify classifyTable)
192+ s0 <- InputState BS8.empty ClassifierStart
193+ <$> readIORef (_configRef input)
194+ <*> pure (InputBuffer bufferPtr bufferSize)
195+ <*> pure (classify classifyTable)
172196 runReaderT (evalStateT loopInputProcessor s0) input
173197
198+-- | Construct two IO actions: one to configure the terminal for Vty and
199+-- one to restore the terminal mode flags to the values they had at the
200+-- time this function was called.
201+--
202+-- This function constructs a configuration action to clear the
203+-- following terminal mode flags:
204+--
205+-- * IXON disabled: disables software flow control on outgoing data.
206+-- This stops the process from being suspended if the output terminal
207+-- cannot keep up.
208+--
209+-- * Raw mode is used for input.
210+--
211+-- * ISIG (enables keyboard combinations that result in
212+-- signals)
213+--
214+-- * ECHO (input is not echoed to the output)
215+--
216+-- * ICANON (canonical mode (line mode) input is not used)
217+--
218+-- * IEXTEN (extended functions are disabled)
219+--
220+-- The configuration action also explicitly sets these flags:
221+--
222+-- * ICRNL (input carriage returns are mapped to newlines)
174223attributeControl :: Fd -> IO (IO (), IO ())
175224attributeControl fd = do
176225 original <- getTerminalAttributes fd
177− let vtyMode = foldl withoutMode original [ StartStopOutput, KeyboardInterrupts
178− , EnableEcho, ProcessInput, ExtendedFunctions
179− ]
226+ let vtyMode = foldl withMode clearedFlags flagsToSet
227+ clearedFlags = foldl withoutMode original flagsToUnset
228+ flagsToSet = [ MapCRtoLF -- ICRNL
229+ ]
230+ flagsToUnset = [ StartStopOutput -- IXON
231+ , KeyboardInterrupts -- ISIG
232+ , EnableEcho -- ECHO
233+ , ProcessInput -- ICANON
234+ , ExtendedFunctions -- IEXTEN
235+ ]
180236 let setAttrs = setTerminalAttributes fd vtyMode Immediately
181237 unsetAttrs = setTerminalAttributes fd original Immediately
182− return (setAttrs,unsetAttrs)
238+ return (setAttrs, unsetAttrs)
183239
184240logInitialInputState :: Input -> ClassifyMap -> IO()
185241logInitialInputState input classifyTable = case _inputDebug input of
@@ -187,7 +243,7 @@ logInitialInputState input classifyTable = case _inputDebug input of
187243 Just h -> do
188244 Config{ vmin = Just theVmin
189245 , vtime = Just theVtime
190− , termName = Just theTerm, .. } <- readIORef $ _configRef input
246+ , termName = Just theTerm } <- readIORef $ _configRef input
191247 _ <- hPrintf h "initial (vmin,vtime): %s\n" (show (theVmin, theVtime))
192248 forM_ classifyTable $ \i -> case i of
193249 (inBytes, EvKey k mods) -> hPrintf h "map %s %s %s %s\n" (show theTerm)
@@ -203,6 +259,7 @@ initInput config classifyTable = do
203259 applyConfig fd config
204260 stopSync <- newEmptyMVar
205261 input <- Input <$> atomically newTChan
262+ <*> pure (return ())
206263 <*> pure (return ())
207264 <*> newIORef config
208265 <*> maybe (return Nothing)
src/Graphics/Vty/Input/Mouse.hs+19−17
@@ -15,10 +15,12 @@ import Graphics.Vty.Input.Classify.Types
1515import Graphics.Vty.Input.Classify.Parse
1616
1717import Control.Monad.State
18−import Data.List (isPrefixOf)
1918import Data.Maybe (catMaybes)
2019import Data.Bits ((.&.))
2120
21+import qualified Data.ByteString.Char8 as BS8
22+import Data.ByteString.Char8 (ByteString)
23+
2224-- A mouse event in SGR extended mode is
2325--
2426-- '\ESC' '[' '<' B ';' X ';' Y ';' ('M'|'m')
@@ -32,28 +34,28 @@ import Data.Bits ((.&.))
3234
3335-- | These sequences set xterm-based terminals to send mouse event
3436-- sequences.
35−requestMouseEvents :: String
36−requestMouseEvents = "\ESC[?1000h\ESC[?1002h\ESC[?1006h"
37+requestMouseEvents :: ByteString
38+requestMouseEvents = BS8.pack "\ESC[?1000h\ESC[?1002h\ESC[?1006h"
3739
3840-- | These sequences disable mouse events.
39−disableMouseEvents :: String
40−disableMouseEvents = "\ESC[?1000l\ESC[?1002l\ESC[?1006l"
41+disableMouseEvents :: ByteString
42+disableMouseEvents = BS8.pack "\ESC[?1000l\ESC[?1002l\ESC[?1006l"
4143
4244-- | Does the specified string begin with a mouse event?
43−isMouseEvent :: String -> Bool
45+isMouseEvent :: ByteString -> Bool
4446isMouseEvent s = isSGREvent s || isNormalEvent s
4547
46−isSGREvent :: String -> Bool
47−isSGREvent = isPrefixOf sgrPrefix
48+isSGREvent :: ByteString -> Bool
49+isSGREvent = BS8.isPrefixOf sgrPrefix
4850
49−sgrPrefix :: String
50−sgrPrefix = "\ESC[M"
51+sgrPrefix :: ByteString
52+sgrPrefix = BS8.pack "\ESC[M"
5153
52−isNormalEvent :: String -> Bool
53−isNormalEvent = isPrefixOf normalPrefix
54+isNormalEvent :: ByteString -> Bool
55+isNormalEvent = BS8.isPrefixOf normalPrefix
5456
55−normalPrefix :: String
56−normalPrefix = "\ESC[<"
57+normalPrefix :: ByteString
58+normalPrefix = BS8.pack "\ESC[<"
5759
5860-- Modifier bits:
5961shiftBit :: Int
@@ -87,8 +89,8 @@ scrollDown = 65
8789hasBitSet :: Int -> Int -> Bool
8890hasBitSet val bit = val .&. bit > 0
8991
90−-- | Attempt to lassify an input string as a mouse event.
91−classifyMouseEvent :: String -> KClass
92+-- | Attempt to classify an input string as a mouse event.
93+classifyMouseEvent :: ByteString -> KClass
9294classifyMouseEvent s = runParser s $ do
9395 when (not $ isMouseEvent s) failParse
9496
@@ -100,7 +102,7 @@ classifyMouseEvent s = runParser s $ do
100102 'M' -> classifyNormalMouseEvent
101103 _ -> failParse
102104
103−-- Given a modifer/button value, determine which button was indicated
105+-- Given a modifier/button value, determine which button was indicated
104106getSGRButton :: Int -> Parser Button
105107getSGRButton mods =
106108 let buttonMap = [ (leftButton, BLeft)
src/Graphics/Vty/Input/Paste.hs+16−24
@@ -9,41 +9,33 @@ module Graphics.Vty.Input.Paste
99where
1010
1111import qualified Data.ByteString.Char8 as BS8
12+import Data.ByteString.Char8 (ByteString)
1213
1314import Graphics.Vty.Input.Events
1415import Graphics.Vty.Input.Classify.Types
1516
16−import Data.List (isPrefixOf, isInfixOf)
17+bracketedPasteStart :: ByteString
18+bracketedPasteStart = BS8.pack "\ESC[200~"
1719
18−bracketedPasteStart :: String
19−bracketedPasteStart = "\ESC[200~"
20−
21−bracketedPasteEnd :: String
22−bracketedPasteEnd = "\ESC[201~"
20+bracketedPasteEnd :: ByteString
21+bracketedPasteEnd = BS8.pack "\ESC[201~"
2322
2423-- | Does the input start a bracketed paste?
25−bracketedPasteStarted :: String -> Bool
26−bracketedPasteStarted = isPrefixOf bracketedPasteStart
24+bracketedPasteStarted :: ByteString -> Bool
25+bracketedPasteStarted = BS8.isPrefixOf bracketedPasteStart
2726
2827-- | Does the input contain a complete bracketed paste?
29−bracketedPasteFinished :: String -> Bool
30−bracketedPasteFinished = isInfixOf bracketedPasteEnd
28+bracketedPasteFinished :: ByteString -> Bool
29+bracketedPasteFinished = BS8.isInfixOf bracketedPasteEnd
3130
3231-- | Parse a bracketed paste. This should only be called on a string if
3332-- both 'bracketedPasteStarted' and 'bracketedPasteFinished' return
3433-- 'True'.
35−parseBracketedPaste :: String -> KClass
34+parseBracketedPaste :: ByteString -> KClass
3635parseBracketedPaste s =
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)
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
src/Graphics/Vty/Input/Terminfo.hs+6−4
@@ -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,10 +86,12 @@ 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− [ -- special support for ESC
90− ("\ESC",EvKey KEsc []), ("\ESC\ESC",EvKey KEsc [MMeta])
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])
9193 -- Special support for backspace
92− , ("\DEL",EvKey KBS []), ("\ESC\DEL",EvKey KBS [MMeta])
94+ , ("\DEL",EvKey KBS []), ("\ESC\DEL",EvKey KBS [MMeta]), ("\b",EvKey KBS [])
9395 -- Special support for Enter
9496 , ("\ESC\^J",EvKey KEnter [MMeta]), ("\^J",EvKey KEnter [])
9597 -- 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-(nrs!!0)+ff) m) | n <- nrs ] in
62+ let f ff nrs m = [ ("\ESC["++show n++"~",EvKey (KFun $ n-head nrs+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+6−5
@@ -1,4 +1,4 @@
1−{-# LANGUAGE RecordWildCards, NamedFieldPuns, CPP #-}
1+{-# LANGUAGE RecordWildCards, CPP #-}
22-- | This module provides functions for accessing the current terminal
33-- or a specific terminal device.
44--
@@ -58,11 +58,12 @@ 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, .. } = do
61+outputForConfig Config{ outputFd = Just fd, termName = Just termName
62+ , colorMode = Just colorMode, .. } = do
6263 t <- if "xterm" `isPrefixOf` termName || "screen" `isPrefixOf` termName
63− then XTermColor.reserveTerminal termName fd
64+ then XTermColor.reserveTerminal termName fd colorMode
6465 -- Not an xterm-like terminal. try for generic terminfo.
65− else TerminfoBased.reserveTerminal termName fd
66+ else TerminfoBased.reserveTerminal termName fd colorMode
6667
6768 case mouseMode of
6869 Just s -> setMode t Mouse s
@@ -77,7 +78,7 @@ outputForConfig config = (<> config) <$> standardIOConfig >>= outputForConfig
7778
7879-- | Sets the cursor position to the given output column and row.
7980--
80−-- This is not necessarially the same as the character position with the
81+-- This is not necessarily the same as the character position with the
8182-- same coordinates. Characters can be a variable number of columns in
8283-- width.
8384--
src/Graphics/Vty/Output/Interface.hs+47−18
@@ -1,9 +1,9 @@
11-- Copyright Corey O'Connor
2−{-# LANGUAGE BangPatterns #-}
32{-# LANGUAGE RankNTypes #-}
43{-# LANGUAGE ExistentialQuantification #-}
54{-# LANGUAGE GADTs #-}
65{-# 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
@@ -73,13 +73,12 @@ data Output = Output
7373 -- | Return the display to the state before `reserveDisplay` If no
7474 -- previous state then set the display state to the initial state.
7575 , releaseDisplay :: IO ()
76+ -- | Sets the current display bounds (width, height).
77+ , setDisplayBounds :: (Int, Int) -> IO ()
7678 -- | Returns the current display bounds.
7779 , displayBounds :: IO DisplayRegion
7880 -- | Output the bytestring to the terminal device.
7981 , outputByteBuffer :: BS.ByteString -> IO ()
80− -- | Specifies the maximum number of colors supported by the
81− -- context.
82− , contextColorCount :: Int
8382 -- | Specifies whether the cursor can be shown / hidden.
8483 , supportsCursorVisibility :: Bool
8584 -- | Indicates support for terminal modes for this output device.
@@ -99,6 +98,24 @@ data Output = Output
9998 , ringTerminalBell :: IO ()
10099 -- | Returns whether the terminal has an audio bell feature.
101100 , 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
102119 }
103120
104121displayContext :: Output -> DisplayRegion -> IO DisplayContext
@@ -189,6 +206,12 @@ outputPicture dc pic = do
189206 AbsoluteCursor x y ->
190207 writeShowCursor dc `mappend`
191208 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)
192215 Cursor x y ->
193216 let m = cursorOutputMap ops $ picCursor pic
194217 (ox, oy) = charToOutputPos m (clampX x, clampY y)
@@ -286,17 +309,23 @@ limitAttrForDisplay t attr
286309 where
287310 clampColor Default = Default
288311 clampColor KeepCurrent = KeepCurrent
289− clampColor (SetTo c) = clampColor' c
290− clampColor' (ISOColor v)
291− | contextColorCount t < 8 = Default
292− | contextColorCount t < 16 && v >= 8 = SetTo $ ISOColor (v - 8)
293− | otherwise = SetTo $ ISOColor v
294− clampColor' (Color240 v)
295− -- Should we choose closest ISO color?
296− | contextColorCount t < 8 = Default
297− | contextColorCount t < 16 = Default
298− | contextColorCount t <= 256 = SetTo $ Color240 v
299− | otherwise
300− = let p :: Double = fromIntegral v / 240.0
301− v' = floor $ p * (fromIntegral $ contextColorCount t)
302− in SetTo $ Color240 v'
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
src/Graphics/Vty/Output/Mock.hs+6−2
@@ -11,6 +11,7 @@ module Graphics.Vty.Output.Mock
1111where
1212
1313import Graphics.Vty.Image (DisplayRegion)
14+import Graphics.Vty.Attributes.Color (ColorMode(ColorMode16))
1415import Graphics.Vty.Output.Interface
1516
1617import Blaze.ByteString.Builder.Word (writeWord8)
@@ -30,7 +31,7 @@ type MockData = IORef (UTF8.UTF8 BS.ByteString)
3031-- without considering terminal specific issues.
3132--
3233-- The mock implementation is useful in manually determining if the
33−-- sequence of terminal operations matche the expected sequence. The
34+-- sequence of terminal operations matches the expected sequence. The
3435-- requirement of the produced representation is simplicity in parsing
3536-- the text representation and determining how the picture was mapped to
3637-- terminal operations.
@@ -48,16 +49,19 @@ mockTerminal r = liftIO $ do
4849 , releaseDisplay = return ()
4950 , ringTerminalBell = return ()
5051 , supportsBell = return False
52+ , supportsItalics = return False
53+ , supportsStrikethrough = return False
54+ , setDisplayBounds = const $ return ()
5155 , displayBounds = return r
5256 , outputByteBuffer = \bytes -> do
5357 putStrLn $ "mock outputByteBuffer of " ++ show (BS.length bytes) ++ " bytes"
5458 writeIORef outRef $ UTF8.fromRep bytes
55− , contextColorCount = 16
5659 , supportsCursorVisibility = True
5760 , supportsMode = const False
5861 , setMode = const $ const $ return ()
5962 , getModeStatus = const $ return False
6063 , assumedStateRef = newAssumedStateRef
64+ , outputColorMode = ColorMode16
6165 , mkDisplayContext = \tActual rActual -> return $ DisplayContext
6266 { contextRegion = rActual
6367 , contextDevice = tActual
src/Graphics/Vty/Output/TerminfoBased.hs+106−39
@@ -1,4 +1,3 @@
1−{-# LANGUAGE RecordWildCards #-}
21{-# LANGUAGE FlexibleInstances #-}
32{-# LANGUAGE OverloadedStrings #-}
43{-# LANGUAGE CPP #-}
@@ -10,10 +9,12 @@
109-- Copyright Corey O'Connor (coreyoconnor@gmail.com)
1110module Graphics.Vty.Output.TerminfoBased
1211 ( reserveTerminal
12+ , setWindowSize
1313 )
1414where
1515
1616import Control.Monad (when)
17+import Data.Bits (shiftL, (.&.))
1718import qualified Data.ByteString as BS
1819import Data.ByteString.Internal (toForeignPtr)
1920import Data.Terminfo.Parse
@@ -24,9 +25,8 @@ import Graphics.Vty.Image (DisplayRegion)
2425import Graphics.Vty.DisplayAttributes
2526import Graphics.Vty.Output.Interface
2627
27−import Blaze.ByteString.Builder (Write, writeToByteString, writeStorable)
28+import Blaze.ByteString.Builder (Write, writeToByteString, writeStorable, writeWord8)
2829
29−import Data.Bits ((.&.))
3030import Data.IORef
3131import Data.Maybe (isJust, isNothing, fromJust)
3232import Data.Word
@@ -49,7 +49,6 @@ data TerminfoCaps = TerminfoCaps
4949 , cup :: CapExpression
5050 , cnorm :: Maybe CapExpression
5151 , civis :: Maybe CapExpression
52− , supportsNoColors :: Bool
5352 , useAltColorMap :: Bool
5453 , setForeColor :: CapExpression
5554 , setBackColor :: CapExpression
@@ -66,6 +65,8 @@ data DisplayAttrCaps = DisplayAttrCaps
6665 , exitStandout :: Maybe CapExpression
6766 , enterItalic :: Maybe CapExpression
6867 , exitItalic :: Maybe CapExpression
68+ , enterStrikethrough :: Maybe CapExpression
69+ , exitStrikethrough :: Maybe CapExpression
6970 , enterUnderline :: Maybe CapExpression
7071 , exitUnderline :: Maybe CapExpression
7172 , enterReverseVideo :: Maybe CapExpression
@@ -102,28 +103,28 @@ sendCapToTerminal t cap capParams = do
102103--
103104-- * Providing independent string capabilities for all display
104105-- attributes.
105−reserveTerminal :: String -> Fd -> IO Output
106−reserveTerminal termName outFd = do
106+reserveTerminal :: String -> Fd -> ColorMode -> IO Output
107+reserveTerminal termName outFd colorMode = do
107108 ti <- Terminfo.setupTerm termName
108109 -- assumes set foreground always implies set background exists.
109110 -- if set foreground is not set then all color changing style
110111 -- attributes are filtered.
111112 msetaf <- probeCap ti "setaf"
112113 msetf <- probeCap ti "setf"
113− let (noColors, useAlt, setForeCap)
114+ let (useAlt, setForeCap)
114115 = case msetaf of
115− Just setaf -> (False, False, setaf)
116+ Just setaf -> (False, setaf)
116117 Nothing -> case msetf of
117− Just setf -> (False, True, setf)
118− Nothing -> (True, True, error $ "no fore color support for terminal " ++ termName)
118+ Just setf -> (True, setf)
119+ Nothing -> (True, error $ "no fore color support for terminal " ++ termName)
119120 msetab <- probeCap ti "setab"
120121 msetb <- probeCap ti "setb"
121− let set_back_cap
122+ let setBackCap
122123 = case msetab of
124+ Just setab -> setab
123125 Nothing -> case msetb of
124126 Just setb -> setb
125127 Nothing -> error $ "no back color support for terminal " ++ termName
126− Just setab -> setab
127128
128129 hyperlinkModeStatus <- newIORef False
129130 newAssumedStateRef <- newIORef initialAssumedState
@@ -149,10 +150,9 @@ reserveTerminal termName outFd = do
149150 <*> requireCap ti "cup"
150151 <*> probeCap ti "cnorm"
151152 <*> probeCap ti "civis"
152− <*> pure noColors
153153 <*> pure useAlt
154154 <*> pure setForeCap
155− <*> pure set_back_cap
155+ <*> pure setBackCap
156156 <*> requireCap ti "sgr0"
157157 <*> requireCap ti "clear"
158158 <*> requireCap ti "el"
@@ -164,6 +164,10 @@ reserveTerminal termName outFd = do
164164 sendCap setDefaultAttr []
165165 maybeSendCap cnorm []
166166 , 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))
167171 , ringTerminalBell = maybeSendCap ringBellAudio []
168172 , reserveDisplay = do
169173 -- If there is no support for smcup: Clear the screen
@@ -174,6 +178,8 @@ reserveTerminal termName outFd = do
174178 , releaseDisplay = do
175179 maybeSendCap rmcup []
176180 maybeSendCap cnorm []
181+ , setDisplayBounds = \(w, h) ->
182+ setWindowSize outFd (w, h)
177183 , displayBounds = do
178184 rawSize <- getWindowSize outFd
179185 case rawSize of
@@ -186,20 +192,15 @@ reserveTerminal termName outFd = do
186192 when (toEnum len /= actualLen) $ fail $ "Graphics.Vty.Output: outputByteBuffer "
187193 ++ "length mismatch. " ++ show len ++ " /= " ++ show actualLen
188194 ++ " Please report this bug to vty project."
189− , contextColorCount
190− = case supportsNoColors terminfoCaps of
191− False -> case Terminfo.getCapability ti (Terminfo.tiGetNum "colors" ) of
192− Nothing -> 8
193− Just v -> toEnum v
194− True -> 1
195195 , supportsCursorVisibility = isJust $ civis terminfoCaps
196196 , supportsMode = terminfoModeSupported
197197 , setMode = terminfoSetMode
198198 , getModeStatus = terminfoModeStatus
199199 , assumedStateRef = newAssumedStateRef
200+ , outputColorMode = colorMode
200201 -- I think fix would help assure tActual is the only
201202 -- reference. I was having issues tho.
202− , mkDisplayContext = \tActual -> terminfoDisplayContext tActual terminfoCaps
203+ , mkDisplayContext = (`terminfoDisplayContext` terminfoCaps)
203204 }
204205 sendCap s = sendCapToTerminal t (s terminfoCaps)
205206 maybeSendCap s = when (isJust $ s terminfoCaps) . sendCap (fromJust . s)
@@ -231,6 +232,8 @@ currentDisplayAttrCaps ti
231232 <*> probeCap ti "rmso"
232233 <*> probeCap ti "sitm"
233234 <*> probeCap ti "ritm"
235+ <*> probeCap ti "smxx"
236+ <*> probeCap ti "rmxx"
234237 <*> probeCap ti "smul"
235238 <*> probeCap ti "rmul"
236239 <*> probeCap ti "rev"
@@ -244,6 +247,13 @@ getWindowSize fd = do
244247 (a,b) <- (`divMod` 65536) `fmap` c_getWindowSize fd
245248 return (fromIntegral b, fromIntegral a)
246249
250+foreign import ccall "gwinsz.h vty_c_set_window_size" c_setWindowSize :: Fd -> CLong -> IO ()
251+
252+setWindowSize :: Fd -> (Int, Int) -> IO ()
253+setWindowSize fd (w, h) = do
254+ let val = (h `shiftL` 16) + w
255+ c_setWindowSize fd $ fromIntegral val
256+
247257terminfoDisplayContext :: Output -> TerminfoCaps -> DisplayRegion -> IO DisplayContext
248258terminfoDisplayContext tActual terminfoCaps r = return dc
249259 where dc = DisplayContext
@@ -259,7 +269,11 @@ terminfoDisplayContext tActual terminfoCaps r = return dc
259269 , writeSetAttr = terminfoWriteSetAttr dc terminfoCaps
260270 , writeDefaultAttr = \urlsEnabled ->
261271 writeCapExpr (setDefaultAttr terminfoCaps) [] `mappend`
262− (if urlsEnabled then writeURLEscapes EndLink else mempty)
272+ (if urlsEnabled then writeURLEscapes EndLink else mempty) `mappend`
273+ (case exitStrikethrough $ displayAttrCaps terminfoCaps of
274+ Just cap -> writeCapExpr cap []
275+ Nothing -> mempty
276+ )
263277 , writeRowEnd = writeCapExpr (clearEol terminfoCaps) []
264278 , inlineHack = return ()
265279 }
@@ -281,7 +295,7 @@ writeURLEscapes NoLinkChange =
281295-- | Portably setting the display attributes is a giant pain in the ass.
282296--
283297-- If the terminal supports the sgr capability (which sets the on/off
284−-- state of each style directly ; and, for no good reason, resets the
298+-- state of each style directly; and, for no good reason, resets the
285299-- colors to the default) this procedure is used:
286300--
287301-- 0. set the style attributes. This resets the fore and back color.
@@ -320,9 +334,9 @@ terminfoWriteSetAttr dc terminfoCaps urlsEnabled prevAttr reqAttr diffs =
320334 -- The only way to reset either color, portably, to the default
321335 -- is to use either the set state capability or the set default
322336 -- capability.
323− True -> do
337+ True -> do
324338 case reqDisplayCapSeqFor (displayAttrCaps terminfoCaps)
325− (fixedStyle attr )
339+ (fixedStyle attr)
326340 (styleToApplySeq $ fixedStyle attr) of
327341 -- only way to reset a color to the defaults
328342 EnterExitSeq caps -> writeDefaultAttr dc urlsEnabled
@@ -332,11 +346,11 @@ terminfoWriteSetAttr dc terminfoCaps urlsEnabled prevAttr reqAttr diffs =
332346 setColors
333347 -- implicitly resets the colors to the defaults
334348 SetState state -> writeCapExpr (fromJust $ setAttrStates
335− $ displayAttrCaps
336− $ terminfoCaps
349+ $ displayAttrCaps terminfoCaps
337350 )
338351 (sgrArgsForState state)
339352 `mappend` setItalics
353+ `mappend` setStrikethrough
340354 `mappend` setColors
341355 -- Otherwise the display colors are not changing or changing
342356 -- between two non-default points.
@@ -355,15 +369,16 @@ terminfoWriteSetAttr dc terminfoCaps urlsEnabled prevAttr reqAttr diffs =
355369 -- applied states.
356370 EnterExitSeq caps -> foldMap (\cap -> writeCapExpr cap []) caps
357371 `mappend`
358− writeColorDiff setForeColor (foreColorDiff diffs)
372+ writeColorDiff Foreground (foreColorDiff diffs)
359373 `mappend`
360− writeColorDiff setBackColor (backColorDiff diffs)
374+ writeColorDiff Background (backColorDiff diffs)
361375 -- implicitly resets the colors to the defaults
362376 SetState state -> writeCapExpr (fromJust $ setAttrStates
363377 $ displayAttrCaps terminfoCaps
364378 )
365379 (sgrArgsForState state)
366380 `mappend` setItalics
381+ `mappend` setStrikethrough
367382 `mappend` setColors
368383 where
369384 urlAttrs True = writeURLEscapes (urlDiff diffs)
@@ -381,31 +396,72 @@ terminfoWriteSetAttr dc terminfoCaps urlsEnabled prevAttr reqAttr diffs =
381396 , Just sitm <- enterItalic (displayAttrCaps terminfoCaps)
382397 = writeCapExpr sitm []
383398 | otherwise = mempty
399+ setStrikethrough
400+ | hasStyle (fixedStyle attr) strikethrough
401+ , Just smxx <- enterStrikethrough (displayAttrCaps terminfoCaps)
402+ = writeCapExpr smxx []
403+ | otherwise = mempty
384404 setColors =
385405 (case fixedForeColor attr of
386− Just c -> writeCapExpr (setForeColor terminfoCaps)
387− [toEnum $ colorMap c]
406+ Just c -> writeColor Foreground c
388407 Nothing -> mempty)
389408 `mappend`
390409 (case fixedBackColor attr of
391− Just c -> writeCapExpr (setBackColor terminfoCaps)
392− [toEnum $ colorMap c]
410+ Just c -> writeColor Background c
393411 Nothing -> mempty)
394− writeColorDiff _f NoColorChange
412+ writeColorDiff _side NoColorChange
395413 = mempty
396− writeColorDiff _f ColorToDefault
414+ writeColorDiff _side ColorToDefault
397415 = error "ColorToDefault is not a possible case for applyColorDiffs"
398− writeColorDiff f (SetColor c)
399− = writeCapExpr (f terminfoCaps) [toEnum $ colorMap c]
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"
400452
401453-- | The color table used by a terminal is a 16 color set followed by a
402454-- 240 color set that might not be supported by the terminal.
403455--
404−-- This takes a Color which clearly identifies which pallete to use and
405−-- computes the index into the full 256 color pallete.
456+-- This takes a Color which clearly identifies which palette to use and
457+-- computes the index into the full 256 color palette.
406458ansiColorIndex :: Color -> Int
407459ansiColorIndex (ISOColor v) = fromEnum v
408460ansiColorIndex (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+ ]
409465
410466-- | For terminals without setaf/setab
411467--
@@ -422,6 +478,10 @@ altColorIndex (ISOColor 6) = 3
422478altColorIndex (ISOColor 7) = 7
423479altColorIndex (ISOColor v) = fromEnum v
424480altColorIndex (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+ ]
425485
426486{- | The sequence of terminfo caps to apply a given style are determined
427487 - according to these rules.
@@ -449,6 +509,7 @@ data DisplayAttrState = DisplayAttrState
449509 { applyStandout :: Bool
450510 , applyUnderline :: Bool
451511 , applyItalic :: Bool
512+ , applyStrikethrough :: Bool
452513 , applyReverseVideo :: Bool
453514 , applyBlink :: Bool
454515 , applyDim :: Bool
@@ -485,6 +546,8 @@ reqDisplayCapSeqFor caps s diffs
485546 -- set state cap then just use the set state cap.
486547 ( True, True ) -> SetState $ stateForStyle s
487548 where
549+ noEnterExitCap ApplyStrikethrough = isNothing $ enterStrikethrough caps
550+ noEnterExitCap RemoveStrikethrough = isNothing $ exitStrikethrough caps
488551 noEnterExitCap ApplyItalic = isNothing $ enterItalic caps
489552 noEnterExitCap RemoveItalic = isNothing $ exitItalic caps
490553 noEnterExitCap ApplyStandout = isNothing $ enterStandout caps
@@ -499,6 +562,8 @@ reqDisplayCapSeqFor caps s diffs
499562 noEnterExitCap RemoveDim = True
500563 noEnterExitCap ApplyBold = isNothing $ enterBoldMode caps
501564 noEnterExitCap RemoveBold = True
565+ enterExitCap ApplyStrikethrough = fromJust $ enterStrikethrough caps
566+ enterExitCap RemoveStrikethrough = fromJust $ exitStrikethrough caps
502567 enterExitCap ApplyItalic = fromJust $ enterItalic caps
503568 enterExitCap RemoveItalic = fromJust $ exitItalic caps
504569 enterExitCap ApplyStandout = fromJust $ enterStandout caps
@@ -515,6 +580,7 @@ stateForStyle s = DisplayAttrState
515580 { applyStandout = isStyleSet standout
516581 , applyUnderline = isStyleSet underline
517582 , applyItalic = isStyleSet italic
583+ , applyStrikethrough = isStyleSet strikethrough
518584 , applyReverseVideo = isStyleSet reverseVideo
519585 , applyBlink = isStyleSet blink
520586 , applyDim = isStyleSet dim
@@ -527,6 +593,7 @@ styleToApplySeq s = concat
527593 [ applyIfRequired ApplyStandout standout
528594 , applyIfRequired ApplyUnderline underline
529595 , applyIfRequired ApplyItalic italic
596+ , applyIfRequired ApplyStrikethrough strikethrough
530597 , applyIfRequired ApplyReverseVideo reverseVideo
531598 , applyIfRequired ApplyBlink blink
532599 , applyIfRequired ApplyDim dim
src/Graphics/Vty/Output/XTermColor.hs+27−18
@@ -10,17 +10,23 @@ where
1010import Graphics.Vty.Output.Interface
1111import Graphics.Vty.Input.Mouse
1212import Graphics.Vty.Input.Focus
13+import Graphics.Vty.Attributes.Color (ColorMode)
1314import qualified Graphics.Vty.Output.TerminfoBased as TerminfoBased
1415
1516import Blaze.ByteString.Builder (writeToByteString)
1617import Blaze.ByteString.Builder.Word (writeWord8)
1718
19+import qualified Data.ByteString.Char8 as BS8
20+import Data.ByteString.Char8 (ByteString)
21+import Foreign.Ptr (castPtr)
22+
1823import Control.Monad (void, when)
1924import Control.Monad.Trans
25+import Data.Char (toLower)
2026import Data.IORef
2127
22−import System.Posix.IO (fdWrite)
23−import System.Posix.Types (Fd)
28+import System.Posix.IO (fdWriteBuf)
29+import System.Posix.Types (ByteCount, Fd)
2430import System.Posix.Env (getEnv)
2531
2632import Data.List (isInfixOf)
@@ -30,9 +36,15 @@ import Data.Maybe (catMaybes)
3036import Data.Monoid ((<>))
3137#endif
3238
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+
3345-- | Construct an Xterm output driver. Initialize the display to UTF-8.
34−reserveTerminal :: ( Applicative m, MonadIO m ) => String -> Fd -> m Output
35−reserveTerminal variant outFd = liftIO $ do
46+reserveTerminal :: ( Applicative m, MonadIO m ) => String -> Fd -> ColorMode -> m Output
47+reserveTerminal variant outFd colorMode = liftIO $ do
3648 let flushedPut = void . fdWrite outFd
3749 -- If the terminal variant is xterm-color use xterm instead since,
3850 -- more often than not, xterm-color is broken.
@@ -40,7 +52,7 @@ reserveTerminal variant outFd = liftIO $ do
4052
4153 utf8a <- utf8Active
4254 when (not utf8a) $ flushedPut setUtf8CharSet
43− t <- TerminfoBased.reserveTerminal variant' outFd
55+ t <- TerminfoBased.reserveTerminal variant' outFd colorMode
4456
4557 mouseModeStatus <- newIORef False
4658 focusModeStatus <- newIORef False
@@ -92,30 +104,27 @@ reserveTerminal variant outFd = liftIO $ do
92104utf8Active :: IO Bool
93105utf8Active = do
94106 let vars = ["LC_ALL", "LANG", "LC_CTYPE"]
95− results <- catMaybes <$> mapM getEnv vars
96− let matches = filter ("UTF8" `isInfixOf`) results <>
97− filter ("UTF-8" `isInfixOf`) results
107+ results <- map (toLower <$>) . catMaybes <$> mapM getEnv vars
108+ let matches = filter ("utf8" `isInfixOf`) results <>
109+ filter ("utf-8" `isInfixOf`) results
98110 return $ not $ null matches
99111
100112-- | Enable bracketed paste mode:
101113-- http://cirw.in/blog/bracketed-paste
102−enableBracketedPastes :: String
103−enableBracketedPastes = "\ESC[?2004h"
114+enableBracketedPastes :: ByteString
115+enableBracketedPastes = BS8.pack "\ESC[?2004h"
104116
105117-- | Disable bracketed paste mode:
106−disableBracketedPastes :: String
107−disableBracketedPastes = "\ESC[?2004l"
118+disableBracketedPastes :: ByteString
119+disableBracketedPastes = BS8.pack "\ESC[?2004l"
108120
109121-- | These sequences set xterm based terminals to UTF-8 output.
110122--
111123-- There is no known terminfo capability equivalent to this.
112−setUtf8CharSet, setDefaultCharSet :: String
113−setUtf8CharSet = "\ESC%G"
114−setDefaultCharSet = "\ESC%@"
124+setUtf8CharSet, setDefaultCharSet :: ByteString
125+setUtf8CharSet = BS8.pack "\ESC%G"
126+setDefaultCharSet = BS8.pack "\ESC%@"
115127
116−-- | I think xterm is broken: Reseting the background color as the first
117−-- bytes serialized on a new line does not effect the background color
118−-- xterm uses to clear the line. Which is used *after* the next newline.
119128xtermInlineHack :: Output -> IO ()
120129xtermInlineHack t = do
121130 let writeReset = foldMap (writeWord8.toEnum.fromEnum) "\ESC[K"
src/Graphics/Vty/Picture.hs+8−1
@@ -1,4 +1,3 @@
1−{-# LANGUAGE BangPatterns #-}
21-- A 'Picture' is a background paired with a set of 'Image' layers. The
32-- 'Picture' data structure is representative of the final terminal
43-- view.
@@ -80,6 +79,14 @@ picForLayers is = Picture
8079data Cursor =
8180 -- | Hide the cursor
8281 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
8390 -- | Show the cursor at the given logical column accounting for
8491 -- character width in the presence of multi-column characters.
8592 | 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−-- largerly used only for debugging.
75+-- largely 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 (\layer -> buildSpans layer r) (picLayers pic)
84+ layerOps <- mapM (`buildSpans` 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 lowerRowOps =
140− onUpperOp Vector.empty (Vector.head upperRowOps) (Vector.tail upperRowOps) lowerRowOps
139+mergeRowUnder upperRowOps =
140+ onUpperOp Vector.empty (Vector.head upperRowOps) (Vector.tail upperRowOps)
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+2−4
@@ -1,6 +1,4 @@
11-- Copyright Corey O'Connor
2−{-# LANGUAGE BangPatterns #-}
3−{-# LANGUAGE NamedFieldPuns #-}
42{-# LANGUAGE GADTs #-}
53-- | A picture is translated into a sequences of state changes and
64-- character spans. The attribute is applied to all following spans,
@@ -52,7 +50,7 @@ dropOps :: Int -> SpanOps -> SpanOps
5250dropOps w = snd . splitOpsAt w
5351
5452splitOpsAt :: Int -> SpanOps -> (SpanOps, SpanOps)
55−splitOpsAt inW inOps = splitOpsAt' inW inOps
53+splitOpsAt = splitOpsAt'
5654 where
5755 splitOpsAt' 0 ops = (Vector.empty, ops)
5856 splitOpsAt' remainingColumns ops = case Vector.head ops of
@@ -103,7 +101,7 @@ displayOpsColumns ops
103101
104102-- | The number of rows the DisplayOps are defined for.
105103displayOpsRows :: DisplayOps -> Int
106−displayOpsRows ops = Vector.length ops
104+displayOpsRows = Vector.length
107105
108106affectedRegion :: DisplayOps -> DisplayRegion
109107affectedRegion ops = (displayOpsColumns ops, displayOpsRows ops)
test/VerifyColor240.hsnew file+269
@@ -0,0 +1,269 @@
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,3 +1,4 @@
1+{-# LANGUAGE ScopedTypeVariables #-}
12module VerifyEmptyImageProps where
23
34import Verify
test/VerifyEvalTerminfoCaps.hs+1
@@ -1,5 +1,6 @@
11{-# LANGUAGE BangPatterns #-}
22{-# LANGUAGE NamedFieldPuns #-}
3+{-# LANGUAGE ScopedTypeVariables #-}
34module VerifyEvalTerminfoCaps where
45
56import Blaze.ByteString.Builder.Internal.Write (runWrite, getBound)
test/VerifyImageOps.hs+2−1
@@ -1,3 +1,4 @@
1+{-# LANGUAGE ScopedTypeVariables #-}
12module VerifyImageOps where
23
34import Graphics.Vty.Attributes
@@ -136,7 +137,7 @@ cropBottomLimitsHeight :: Image -> Int -> Property
136137cropBottomLimitsHeight i v = v >= 0 ==>
137138 v >= imageHeight (cropBottom v i)
138139
139−-- rediculous tests just to satisfy my desire for nice code coverage :-P
140+-- ridiculous tests just to satisfy my desire for nice code coverage :-P
140141canShowImage :: Image -> Bool
141142canShowImage i = length (show i) > 0
142143
test/VerifyOutput.hs+7−2
@@ -1,6 +1,7 @@
1−-- We setup the environment to envoke certain terminals of interest.
1+-- We setup the environment to invoke certain terminals of interest.
22-- This assumes appropriate definitions exist in the current environment
33-- for the terminals of interest.
4+{-# LANGUAGE ScopedTypeVariables #-}
45module VerifyOutput where
56
67import Verify
@@ -34,7 +35,11 @@ smokeTestTermNonMac termName i = liftIOResult $ do
3435smokeTestTerm :: String -> Image -> IO Result
3536smokeTestTerm termName i = do
3637 nullOut <- openFd "/dev/null" WriteOnly Nothing defaultFileFlags
37− t <- outputForConfig $ defaultConfig { outputFd = Just nullOut, termName = Just termName }
38+ t <- outputForConfig $ defaultConfig
39+ { outputFd = Just nullOut
40+ , termName = Just termName
41+ , colorMode = Just NoColor
42+ }
3843 -- putStrLn $ "context color count: " ++ show (contextColorCount t)
3944 reserveDisplay t
4045 dc <- displayContext t (100,100)
test/VerifyParseTerminfoCaps.hs+1
@@ -1,4 +1,5 @@
11{-# LANGUAGE NamedFieldPuns #-}
2+{-# LANGUAGE ScopedTypeVariables #-}
23module VerifyParseTerminfoCaps where
34
45import Prelude hiding ( catch )
test/VerifyUsingMockInput.hs+4−1
@@ -1,5 +1,6 @@
11{-# LANGUAGE MultiParamTypeClasses #-}
22{-# LANGUAGE FlexibleInstances #-}
3+{-# LANGUAGE ScopedTypeVariables #-}
34-- Generate some input bytes and delays between blocks of input bytes.
45-- Verify the events produced are as expected.
56module Main where
@@ -131,7 +132,9 @@ assertEventsFromSynInput table inputSpec expectedEvents = do
131132 readLoop 0 = return ()
132133 readLoop n = do
133134 e <- atomically $ readTChan $ input^.eventChannel
134− modifyIORef eventsRef ((:) e)
135+ case e of
136+ InputEvent ev -> modifyIORef eventsRef ((:) ev)
137+ ResumeAfterSignal -> return ()
135138 readLoop (n - 1)
136139 genEventsUsingIoActions maxDuration writeWaitClose readEvents
137140 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−-- Explicitely definethe bytes that encode each example text.
367+-- Explicitly define the 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+46−38
@@ -1,5 +1,5 @@
11name: vty
2−version: 5.28.2
2+version: 5.35.1
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.12,
48+ microlens < 0.4.13,
4949 microlens-mtl,
5050 microlens-th,
5151 hashable >= 1.2,
@@ -69,6 +69,7 @@ library
6969 exposed-modules: Graphics.Vty
7070 Graphics.Vty.Attributes
7171 Graphics.Vty.Attributes.Color
72+ Graphics.Vty.Attributes.Color240
7273 Graphics.Vty.Config
7374 Graphics.Vty.Error
7475 Graphics.Vty.Image
@@ -104,8 +105,7 @@ library
104105 Graphics.Vty.UnicodeWidthTable.Query
105106 Graphics.Vty.UnicodeWidthTable.Install
106107
107− other-modules: Graphics.Vty.Attributes.Color240
108− Graphics.Vty.Debug.Image
108+ other-modules: Graphics.Vty.Debug.Image
109109 Graphics.Vty.Input.Terminfo.ANSIVT
110110
111111 c-sources: cbits/gwinsz.c
@@ -117,8 +117,6 @@ library
117117
118118 hs-source-dirs: src
119119
120− default-extensions: ScopedTypeVariables
121−
122120 ghc-options: -O2 -funbox-strict-fields -Wall -fspec-constr -fspec-constr-count=10
123121
124122 ghc-prof-options: -O2 -funbox-strict-fields -caf-all -Wall -fspec-constr -fspec-constr-count=10
@@ -143,7 +141,6 @@ executable vty-mode-demo
143141 hs-source-dirs: demos
144142
145143 default-language: Haskell2010
146− default-extensions: ScopedTypeVariables
147144 ghc-options: -threaded
148145
149146 build-depends: vty,
@@ -158,7 +155,6 @@ executable vty-demo
158155 hs-source-dirs: demos
159156
160157 default-language: Haskell2010
161− default-extensions: ScopedTypeVariables
162158 ghc-options: -threaded
163159
164160 build-depends: vty,
@@ -170,7 +166,6 @@ executable vty-demo
170166
171167test-suite verify-using-mock-terminal
172168 default-language: Haskell2010
173− default-extensions: ScopedTypeVariables
174169
175170 type: detailed-0.9
176171
@@ -189,7 +184,7 @@ test-suite verify-using-mock-terminal
189184 build-depends: vty,
190185 Cabal >= 1.20,
191186 QuickCheck >= 2.7,
192− random >= 1.0 && < 1.2,
187+ random >= 1.0 && < 1.3,
193188 base >= 4.8 && < 5,
194189 bytestring,
195190 containers,
@@ -203,7 +198,6 @@ test-suite verify-using-mock-terminal
203198
204199test-suite verify-terminal
205200 default-language: Haskell2010
206− default-extensions: ScopedTypeVariables
207201
208202 type: detailed-0.9
209203
@@ -222,7 +216,7 @@ test-suite verify-terminal
222216 build-depends: vty,
223217 Cabal >= 1.20,
224218 QuickCheck >= 2.7,
225− random >= 1.0 && < 1.2,
219+ random >= 1.0 && < 1.3,
226220 base >= 4.8 && < 5,
227221 bytestring,
228222 containers,
@@ -236,7 +230,6 @@ test-suite verify-terminal
236230
237231test-suite verify-display-attributes
238232 default-language: Haskell2010
239− default-extensions: ScopedTypeVariables
240233
241234 type: detailed-0.9
242235
@@ -255,7 +248,7 @@ test-suite verify-display-attributes
255248 build-depends: vty,
256249 Cabal >= 1.20,
257250 QuickCheck >= 2.7,
258− random >= 1.0 && < 1.2,
251+ random >= 1.0 && < 1.3,
259252 base >= 4.8 && < 5,
260253 bytestring,
261254 containers,
@@ -268,7 +261,6 @@ test-suite verify-display-attributes
268261
269262test-suite verify-empty-image-props
270263 default-language: Haskell2010
271− default-extensions: ScopedTypeVariables
272264
273265 type: detailed-0.9
274266
@@ -281,7 +273,7 @@ test-suite verify-empty-image-props
281273 build-depends: vty,
282274 Cabal >= 1.20,
283275 QuickCheck >= 2.7,
284− random >= 1.0 && < 1.2,
276+ random >= 1.0 && < 1.3,
285277 base >= 4.8 && < 5,
286278 bytestring,
287279 containers,
@@ -294,7 +286,6 @@ test-suite verify-empty-image-props
294286
295287test-suite verify-eval-terminfo-caps
296288 default-language: Haskell2010
297− default-extensions: ScopedTypeVariables
298289
299290 type: detailed-0.9
300291
@@ -308,7 +299,7 @@ test-suite verify-eval-terminfo-caps
308299 build-depends: vty,
309300 Cabal >= 1.20,
310301 QuickCheck >= 2.7,
311− random >= 1.0 && < 1.2,
302+ random >= 1.0 && < 1.3,
312303 base >= 4.8 && < 5,
313304 blaze-builder >= 0.3.3.2 && < 0.5,
314305 bytestring,
@@ -323,7 +314,6 @@ test-suite verify-eval-terminfo-caps
323314
324315test-suite verify-image-ops
325316 default-language: Haskell2010
326− default-extensions: ScopedTypeVariables
327317
328318 type: detailed-0.9
329319
@@ -338,7 +328,7 @@ test-suite verify-image-ops
338328 build-depends: vty,
339329 Cabal >= 1.20,
340330 QuickCheck >= 2.7,
341− random >= 1.0 && < 1.2,
331+ random >= 1.0 && < 1.3,
342332 base >= 4.8 && < 5,
343333 bytestring,
344334 containers,
@@ -351,7 +341,6 @@ test-suite verify-image-ops
351341
352342test-suite verify-image-trans
353343 default-language: Haskell2010
354− default-extensions: ScopedTypeVariables
355344
356345 type: detailed-0.9
357346
@@ -366,7 +355,7 @@ test-suite verify-image-trans
366355 build-depends: vty,
367356 Cabal >= 1.20,
368357 QuickCheck >= 2.7,
369− random >= 1.0 && < 1.2,
358+ random >= 1.0 && < 1.3,
370359 base >= 4.8 && < 5,
371360 bytestring,
372361 containers,
@@ -379,7 +368,6 @@ test-suite verify-image-trans
379368
380369test-suite verify-inline
381370 default-language: Haskell2010
382− default-extensions: ScopedTypeVariables
383371
384372 type: detailed-0.9
385373
@@ -393,7 +381,7 @@ test-suite verify-inline
393381 build-depends: vty,
394382 Cabal >= 1.20,
395383 QuickCheck >= 2.7,
396− random >= 1.0 && < 1.2,
384+ random >= 1.0 && < 1.3,
397385 base >= 4.8 && < 5,
398386 bytestring,
399387 containers,
@@ -406,7 +394,6 @@ test-suite verify-inline
406394
407395test-suite verify-parse-terminfo-caps
408396 default-language: Haskell2010
409− default-extensions: ScopedTypeVariables
410397
411398 type: detailed-0.9
412399
@@ -421,7 +408,7 @@ test-suite verify-parse-terminfo-caps
421408 build-depends: vty,
422409 Cabal >= 1.20,
423410 QuickCheck >= 2.7,
424− random >= 1.0 && < 1.2,
411+ random >= 1.0 && < 1.3,
425412 base >= 4.8 && < 5,
426413 bytestring,
427414 containers,
@@ -435,7 +422,6 @@ test-suite verify-parse-terminfo-caps
435422
436423test-suite verify-simple-span-generation
437424 default-language: Haskell2010
438− default-extensions: ScopedTypeVariables
439425
440426 type: detailed-0.9
441427
@@ -453,7 +439,7 @@ test-suite verify-simple-span-generation
453439 build-depends: vty,
454440 Cabal >= 1.20,
455441 QuickCheck >= 2.7,
456− random >= 1.0 && < 1.2,
442+ random >= 1.0 && < 1.3,
457443 base >= 4.8 && < 5,
458444 bytestring,
459445 containers,
@@ -467,7 +453,6 @@ test-suite verify-simple-span-generation
467453
468454test-suite verify-crop-span-generation
469455 default-language: Haskell2010
470− default-extensions: ScopedTypeVariables
471456
472457 type: detailed-0.9
473458
@@ -485,7 +470,7 @@ test-suite verify-crop-span-generation
485470 build-depends: vty,
486471 Cabal >= 1.20,
487472 QuickCheck >= 2.7,
488− random >= 1.0 && < 1.2,
473+ random >= 1.0 && < 1.3,
489474 base >= 4.8 && < 5,
490475 bytestring,
491476 containers,
@@ -499,7 +484,6 @@ test-suite verify-crop-span-generation
499484
500485test-suite verify-layers-span-generation
501486 default-language: Haskell2010
502− default-extensions: ScopedTypeVariables
503487
504488 type: detailed-0.9
505489
@@ -517,7 +501,32 @@ test-suite verify-layers-span-generation
517501 build-depends: vty,
518502 Cabal >= 1.20,
519503 QuickCheck >= 2.7,
520− random >= 1.0 && < 1.2,
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,
521530 base >= 4.8 && < 5,
522531 bytestring,
523532 containers,
@@ -530,7 +539,6 @@ test-suite verify-layers-span-generation
530539
531540test-suite verify-utf8-width
532541 default-language: Haskell2010
533− default-extensions: ScopedTypeVariables
534542
535543 type: detailed-0.9
536544
@@ -543,7 +551,7 @@ test-suite verify-utf8-width
543551 build-depends: vty,
544552 Cabal >= 1.20,
545553 QuickCheck >= 2.7,
546− random >= 1.0 && < 1.2,
554+ random >= 1.0 && < 1.3,
547555 base >= 4.8 && < 5,
548556 bytestring,
549557 containers,
@@ -556,7 +564,6 @@ test-suite verify-utf8-width
556564
557565test-suite verify-using-mock-input
558566 default-language: Haskell2010
559− default-extensions: ScopedTypeVariables
560567
561568 type: exitcode-stdio-1.0
562569
@@ -564,6 +571,8 @@ test-suite verify-using-mock-input
564571
565572 main-is: VerifyUsingMockInput.hs
566573
574+ other-modules: Verify.Graphics.Vty.Output
575+
567576 build-depends: vty,
568577 Cabal >= 1.20,
569578 QuickCheck >= 2.7,
@@ -571,7 +580,7 @@ test-suite verify-using-mock-input
571580 quickcheck-assertions >= 0.1.1,
572581 test-framework == 0.8.*,
573582 test-framework-smallcheck == 0.2.*,
574− random >= 1.0 && < 1.2,
583+ random >= 1.0 && < 1.3,
575584 base >= 4.8 && < 5,
576585 bytestring,
577586 containers,
@@ -590,7 +599,6 @@ test-suite verify-using-mock-input
590599
591600test-suite verify-config
592601 default-language: Haskell2010
593− default-extensions: ScopedTypeVariables
594602
595603 type: exitcode-stdio-1.0
596604
@@ -607,7 +615,7 @@ test-suite verify-config
607615 test-framework == 0.8.*,
608616 test-framework-smallcheck == 0.2.*,
609617 test-framework-hunit,
610− random >= 1.0 && < 1.2,
618+ random >= 1.0 && < 1.3,
611619 base >= 4.8 && < 5,
612620 bytestring,
613621 containers,