vty 5.9.1 → 5.10
raw patch · 12 files changed
+149/−290 lines, 12 filesdep ~microlens
Dependency ranges changed: microlens
Files
- CHANGELOG +17/−0
- cbits/mk_wcwidth.c +3/−108
- src/Graphics/Text/Width.hs +2/−7
- src/Graphics/Vty.hs +5/−19
- src/Graphics/Vty/Config.hs +84/−98
- src/Graphics/Vty/Image/Internal.hs +5/−4
- src/Graphics/Vty/Input/Events.hs +6/−4
- src/Graphics/Vty/Output/Interface.hs +10/−3
- src/Graphics/Vty/Picture.hs +9/−6
- test.hs +0/−20
- test/VerifyConfig.hs +7/−5
- vty.cabal +1/−16
CHANGELOG view
@@ -1,3 +1,20 @@+5.10+ - Add absolute cursor positioning mode AbsoluteCursor to Cursor. This+ mode provides greater control over cursor positioning by bypassing+ the logical positioning provided by default. Rather than positioning+ the cursor by looking at the widths of characters involved, this+ constructor lets you provide a physical row and column instead. This+ is useful in more sophisticated programs. (thanks Eric Mertens)+ - Added a new Generic-derived config parser (thanks Eric Mertens)+ - Fixed the MShift case in the configuration file parser (thanks Eric+ Mertens)+ - Fixed wcwidth import and matched safeWcswidth to its documented+ behavior. Previously vty_mk_wcwidth was being imported with+ the wrong type causing the -1 return value to be mapped to the+ wrong Int value. Additionally safeWcswidth was using the unsafe+ character width function and only ensuring that the final result was+ non-negative. (thanks Eric Mertens)+ 5.9.1 - Vty now only emits UTF8 charset sequences in terminals without a preexisting UTF8 declaration to avoid emitting garbage sequences
cbits/mk_wcwidth.c view
@@ -59,7 +59,7 @@ * Latest version: http://www.cl.cam.ac.uk/~mgk25/ucs/wcwidth.c */ -#include <wchar.h>+#include <HsFFI.h> struct interval { int first;@@ -67,7 +67,7 @@ }; /* auxiliary function for binary search in interval table */-static int vty_bisearch(wchar_t ucs, const struct interval *table, int max) {+static int vty_bisearch(HsChar ucs, const struct interval *table, int max) { int min = 0; int mid; @@ -119,7 +119,7 @@ * in ISO 10646. */ -int vty_mk_wcwidth(wchar_t ucs)+HsInt vty_mk_wcwidth(HsChar ucs) { /* sorted list of non-overlapping intervals of non-spacing characters */ /* generated by "uniset +cat=Me +cat=Mn +cat=Cf -00AD +1160-11FF +200B c" */@@ -201,109 +201,4 @@ (ucs >= 0xffe0 && ucs <= 0xffe6) || (ucs >= 0x20000 && ucs <= 0x2fffd) || (ucs >= 0x30000 && ucs <= 0x3fffd)));-}---int vty_mk_wcswidth(const wchar_t *pwcs, size_t n)-{- int w, width = 0;-- for (;n-- > 0; pwcs++)- if ((w = vty_mk_wcwidth(*pwcs)) < 0)- return -1;- else- width += w;-- return width;-}---/*- * The following functions are the same as mk_wcwidth() and- * mk_wcswidth(), except that spacing characters in the East Asian- * Ambiguous (A) category as defined in Unicode Technical Report #11- * have a column width of 2. This variant might be useful for users of- * CJK legacy encodings who want to migrate to UCS without changing- * the traditional terminal character-width behaviour. It is not- * otherwise recommended for general use.- */-int vty_mk_wcwidth_cjk(wchar_t ucs)-{- /* sorted list of non-overlapping intervals of East Asian Ambiguous- * characters, generated by "uniset +WIDTH-A -cat=Me -cat=Mn -cat=Cf c" */- static const struct interval ambiguous[] = {- { 0x00A1, 0x00A1 }, { 0x00A4, 0x00A4 }, { 0x00A7, 0x00A8 },- { 0x00AA, 0x00AA }, { 0x00AE, 0x00AE }, { 0x00B0, 0x00B4 },- { 0x00B6, 0x00BA }, { 0x00BC, 0x00BF }, { 0x00C6, 0x00C6 },- { 0x00D0, 0x00D0 }, { 0x00D7, 0x00D8 }, { 0x00DE, 0x00E1 },- { 0x00E6, 0x00E6 }, { 0x00E8, 0x00EA }, { 0x00EC, 0x00ED },- { 0x00F0, 0x00F0 }, { 0x00F2, 0x00F3 }, { 0x00F7, 0x00FA },- { 0x00FC, 0x00FC }, { 0x00FE, 0x00FE }, { 0x0101, 0x0101 },- { 0x0111, 0x0111 }, { 0x0113, 0x0113 }, { 0x011B, 0x011B },- { 0x0126, 0x0127 }, { 0x012B, 0x012B }, { 0x0131, 0x0133 },- { 0x0138, 0x0138 }, { 0x013F, 0x0142 }, { 0x0144, 0x0144 },- { 0x0148, 0x014B }, { 0x014D, 0x014D }, { 0x0152, 0x0153 },- { 0x0166, 0x0167 }, { 0x016B, 0x016B }, { 0x01CE, 0x01CE },- { 0x01D0, 0x01D0 }, { 0x01D2, 0x01D2 }, { 0x01D4, 0x01D4 },- { 0x01D6, 0x01D6 }, { 0x01D8, 0x01D8 }, { 0x01DA, 0x01DA },- { 0x01DC, 0x01DC }, { 0x0251, 0x0251 }, { 0x0261, 0x0261 },- { 0x02C4, 0x02C4 }, { 0x02C7, 0x02C7 }, { 0x02C9, 0x02CB },- { 0x02CD, 0x02CD }, { 0x02D0, 0x02D0 }, { 0x02D8, 0x02DB },- { 0x02DD, 0x02DD }, { 0x02DF, 0x02DF }, { 0x0391, 0x03A1 },- { 0x03A3, 0x03A9 }, { 0x03B1, 0x03C1 }, { 0x03C3, 0x03C9 },- { 0x0401, 0x0401 }, { 0x0410, 0x044F }, { 0x0451, 0x0451 },- { 0x2010, 0x2010 }, { 0x2013, 0x2016 }, { 0x2018, 0x2019 },- { 0x201C, 0x201D }, { 0x2020, 0x2022 }, { 0x2024, 0x2027 },- { 0x2030, 0x2030 }, { 0x2032, 0x2033 }, { 0x2035, 0x2035 },- { 0x203B, 0x203B }, { 0x203E, 0x203E }, { 0x2074, 0x2074 },- { 0x207F, 0x207F }, { 0x2081, 0x2084 }, { 0x20AC, 0x20AC },- { 0x2103, 0x2103 }, { 0x2105, 0x2105 }, { 0x2109, 0x2109 },- { 0x2113, 0x2113 }, { 0x2116, 0x2116 }, { 0x2121, 0x2122 },- { 0x2126, 0x2126 }, { 0x212B, 0x212B }, { 0x2153, 0x2154 },- { 0x215B, 0x215E }, { 0x2160, 0x216B }, { 0x2170, 0x2179 },- { 0x2190, 0x2199 }, { 0x21B8, 0x21B9 }, { 0x21D2, 0x21D2 },- { 0x21D4, 0x21D4 }, { 0x21E7, 0x21E7 }, { 0x2200, 0x2200 },- { 0x2202, 0x2203 }, { 0x2207, 0x2208 }, { 0x220B, 0x220B },- { 0x220F, 0x220F }, { 0x2211, 0x2211 }, { 0x2215, 0x2215 },- { 0x221A, 0x221A }, { 0x221D, 0x2220 }, { 0x2223, 0x2223 },- { 0x2225, 0x2225 }, { 0x2227, 0x222C }, { 0x222E, 0x222E },- { 0x2234, 0x2237 }, { 0x223C, 0x223D }, { 0x2248, 0x2248 },- { 0x224C, 0x224C }, { 0x2252, 0x2252 }, { 0x2260, 0x2261 },- { 0x2264, 0x2267 }, { 0x226A, 0x226B }, { 0x226E, 0x226F },- { 0x2282, 0x2283 }, { 0x2286, 0x2287 }, { 0x2295, 0x2295 },- { 0x2299, 0x2299 }, { 0x22A5, 0x22A5 }, { 0x22BF, 0x22BF },- { 0x2312, 0x2312 }, { 0x2460, 0x24E9 }, { 0x24EB, 0x254B },- { 0x2550, 0x2573 }, { 0x2580, 0x258F }, { 0x2592, 0x2595 },- { 0x25A0, 0x25A1 }, { 0x25A3, 0x25A9 }, { 0x25B2, 0x25B3 },- { 0x25B6, 0x25B7 }, { 0x25BC, 0x25BD }, { 0x25C0, 0x25C1 },- { 0x25C6, 0x25C8 }, { 0x25CB, 0x25CB }, { 0x25CE, 0x25D1 },- { 0x25E2, 0x25E5 }, { 0x25EF, 0x25EF }, { 0x2605, 0x2606 },- { 0x2609, 0x2609 }, { 0x260E, 0x260F }, { 0x2614, 0x2615 },- { 0x261C, 0x261C }, { 0x261E, 0x261E }, { 0x2640, 0x2640 },- { 0x2642, 0x2642 }, { 0x2660, 0x2661 }, { 0x2663, 0x2665 },- { 0x2667, 0x266A }, { 0x266C, 0x266D }, { 0x266F, 0x266F },- { 0x273D, 0x273D }, { 0x2776, 0x277F }, { 0xE000, 0xF8FF },- { 0xFFFD, 0xFFFD }, { 0xF0000, 0xFFFFD }, { 0x100000, 0x10FFFD }- };-- /* binary search in table of non-spacing characters */- if (vty_bisearch(ucs, ambiguous,- sizeof(ambiguous) / sizeof(struct interval) - 1))- return 2;-- return vty_mk_wcwidth(ucs);-}---int vty_mk_wcswidth_cjk(const wchar_t *pwcs, size_t n)-{- int w, width = 0;-- for (;n-- > 0; pwcs++)- if ((w = vty_mk_wcwidth_cjk(*pwcs)) < 0)- return -1;- else- width += w;-- return width; }
src/Graphics/Text/Width.hs view
@@ -22,13 +22,8 @@ -- | Returns the display width of a character. Assumes all characters with unknown widths are 0 width safeWcwidth :: Char -> Int-safeWcwidth c = case wcwidth c of- i | i < 0 -> 0- | otherwise -> i+safeWcwidth = max 0 . wcwidth -- | Returns the display width of a string. Assumes all characters with unknown widths are 0 width safeWcswidth :: String -> Int-safeWcswidth str = case wcswidth str of- i | i < 0 -> 0- | otherwise -> i-+safeWcswidth = sum . map safeWcwidth
src/Graphics/Vty.hs view
@@ -129,38 +129,24 @@ lastUpdateRef <- newIORef Nothing let innerUpdate inPic = do- b@(w,h) <- displayBounds out- let cursor = picCursor inPic- inPic' = case cursor of- Cursor x y ->- let- x' = case x of- _ | x < 0 -> 0- | x >= w -> w - 1- | otherwise -> x- y' = case y of- _ | y < 0 -> 0- | y >= h -> h - 1- | otherwise -> y- in inPic { picCursor = Cursor x' y' }- _ -> inPic+ b <- displayBounds out mlastUpdate <- readIORef lastUpdateRef updateData <- case mlastUpdate of Nothing -> do dc <- displayContext out b- outputPicture dc inPic'+ outputPicture dc inPic return (b, dc) Just (lastBounds, lastContext) -> do if b /= lastBounds then do dc <- displayContext out b- outputPicture dc inPic'+ outputPicture dc inPic return (b, dc) else do- outputPicture lastContext inPic'+ outputPicture lastContext inPic return (b, lastContext) writeIORef lastUpdateRef $ Just updateData- writeIORef lastPicRef $ Just inPic'+ writeIORef lastPicRef $ Just inPic let innerRefresh = do writeIORef lastUpdateRef Nothing
src/Graphics/Vty/Config.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ScopedTypeVariables #-} -- | A 'Config' can be provided to mkVty to customize the applications use of vty. A config file can -- be used to customize vty for a user's system. --@@ -75,9 +75,7 @@ import Control.Applicative hiding (many) import Control.Exception (catch, IOException)-import Control.Monad (void)-import Control.Monad.Trans.Class-import Control.Monad.Trans.Writer+import Control.Monad (liftM, guard, void) import qualified Data.ByteString as BS import Data.Default@@ -85,6 +83,8 @@ import Graphics.Vty.Input.Events +import GHC.Generics+ import System.Directory (getAppUserDataDirectory) import System.Posix.Env (getEnv) import System.Posix.IO (stdInput, stdOutput)@@ -152,8 +152,6 @@ , termName = termName c1 <|> termName c0 } -type ConfigParser s a = ParsecT s () (Writer Config) a- -- | Config from @'getAppUserDataDirectory'/config@ and @$VTY_CONFIG_FILE@ userConfig :: IO Config userConfig = do@@ -184,111 +182,99 @@ catch (runParseConfig path <$> BS.readFile path) (\(_ :: IOException) -> return def) -runParseConfig :: Stream s (Writer Config) Char => String -> s -> Config-runParseConfig name = execWriter . runParserT parseConfig () name+type Parser = Parsec BS.ByteString () +runParseConfig :: String -> BS.ByteString -> Config+runParseConfig name cfgTxt =+ case runParser parseConfig () name cfgTxt of+ Right cfg -> cfg+ Left{} -> def+ -- I tried to use the haskellStyle here but that was specialized (without requirement?) to the -- String stream type.-configLanguage :: Stream s m Char => P.GenLanguageDef s u m+configLanguage :: Monad m => P.GenLanguageDef BS.ByteString () m configLanguage = LanguageDef- { commentStart = "{-"- , commentEnd = "-}"- , commentLine = "--"- , nestedComments = True- , identStart = letter <|> char '_'- , identLetter = alphaNum <|> oneOf "_'"- , opStart = opLetter configLanguage- , opLetter = oneOf ":!#$%&*+./<=>?@\\^|-~"+ { commentStart = "{-"+ , commentEnd = "-}"+ , commentLine = "--"+ , nestedComments = True+ , identStart = letter <|> char '_'+ , identLetter = alphaNum <|> oneOf "_'"+ , opStart = opLetter configLanguage+ , opLetter = oneOf ":!#$%&*+./<=>?@\\^|-~" , reservedOpNames = []- , reservedNames = []- , caseSensitive = True+ , reservedNames = []+ , caseSensitive = True } -configLexer :: Stream s m Char => P.GenTokenParser s u m+configLexer :: Monad m => P.GenTokenParser BS.ByteString () m configLexer = P.makeTokenParser configLanguage -mapDecl :: forall s u (m :: * -> *).- (Monad m, Stream s (WriterT Config m) Char) =>- ParsecT s u (WriterT Config m) ()+mapDecl :: Parser Config mapDecl = do- void $ string "map"- P.whiteSpace configLexer+ "map" <- P.identifier configLexer termIdent <- (char '_' >> P.whiteSpace configLexer >> return Nothing) <|> (Just <$> P.stringLiteral configLexer)- bytes <- P.stringLiteral configLexer- key <- parseKey- modifiers <- parseModifiers- lift $ tell $ def { inputMap = [(termIdent, bytes, EvKey key modifiers)] }---- TODO: Generated by a vim macro. There is a better way here. Derive parser? Use Read--- instance? Generics?-parseKey :: forall s u (m :: * -> *).- Stream s m Char =>- ParsecT s u m Key-parseKey = do- key <- P.identifier configLexer- case key of- "KChar" -> KChar <$> P.charLiteral configLexer- "KFun" -> KFun . fromInteger <$> P.natural configLexer- "KEsc" -> return KEsc- "KBS" -> return KBS- "KEnter" -> return KEnter- "KLeft" -> return KLeft- "KRight" -> return KRight- "KUp" -> return KUp- "KDown" -> return KDown- "KUpLeft" -> return KUpLeft- "KUpRight" -> return KUpRight- "KDownLeft" -> return KDownLeft- "KDownRight" -> return KDownRight- "KCenter" -> return KCenter- "KBackTab" -> return KBackTab- "KPrtScr" -> return KPrtScr- "KPause" -> return KPause- "KIns" -> return KIns- "KHome" -> return KHome- "KPageUp" -> return KPageUp- "KDel" -> return KDel- "KEnd" -> return KEnd- "KPageDown" -> return KPageDown- "KBegin" -> return KBegin- "KMenu" -> return KMenu- _ -> fail $ key ++ " is not a valid key identifier"--parseModifiers :: forall s u (m :: * -> *).- Stream s m Char =>- ParsecT s u m [Modifier]-parseModifiers = P.brackets configLexer (parseModifier `sepBy` P.symbol configLexer ",")--parseModifier :: forall s u (m :: * -> *).- Stream s m Char =>- ParsecT s u m Modifier-parseModifier = do- m <- P.identifier configLexer- case m of- "KMenu" -> return MShift- "MCtrl" -> return MCtrl- "MMeta" -> return MMeta- "MAlt" -> return MAlt- _ -> fail $ m ++ " is not a valid modifier identifier"+ bytes <- P.stringLiteral configLexer+ key <- parseValue+ modifiers <- parseValue+ return def { inputMap = [(termIdent, bytes, EvKey key modifiers)] } -debugLogDecl :: forall s u (m :: * -> *).- (Monad m, Stream s (WriterT Config m) Char) =>- ParsecT s u (WriterT Config m) ()+debugLogDecl :: Parser Config debugLogDecl = do- void $ string "debugLog"- P.whiteSpace configLexer- path <- P.stringLiteral configLexer- lift $ tell $ def { debugLog = Just path }+ "debugLog" <- P.identifier configLexer+ path <- P.stringLiteral configLexer+ return def { debugLog = Just path } -ignoreLine :: forall s u (m :: * -> *).- Stream s m Char => ParsecT s u m ()+ignoreLine :: Parser () ignoreLine = void $ manyTill anyChar newline -parseConfig :: forall s u (m :: * -> *).- (Monad m, Stream s (WriterT Config m) Char) =>- ParsecT s u (WriterT Config m) ()-parseConfig = void $ many $ do+parseConfig :: Parser Config+parseConfig = liftM mconcat $ many $ do P.whiteSpace configLexer- let directives = [mapDecl, debugLogDecl]- try (choice directives) <|> ignoreLine+ let directives = [try mapDecl, try debugLogDecl]+ choice directives <|> (ignoreLine >> return def)++class Parse a where parseValue :: Parser a+instance Parse Char where parseValue = P.charLiteral configLexer+instance Parse Int where parseValue = fromInteger <$> P.natural configLexer+instance Parse Key where parseValue = genericParse+instance Parse Modifier where parseValue = genericParse+instance Parse a => Parse [a] where+ parseValue = P.brackets configLexer+ (parseValue `sepBy` P.symbol configLexer ",")++------------------------------------------------------------------------+-- Derived parser for ADTs via generics+------------------------------------------------------------------------++genericParse :: (Generic a, GParse (Rep a)) => Parser a+genericParse = to <$> gparse++class GParse f where gparse :: Parser (f a)+instance GParse f => GParse (M1 S i f) where gparse = M1 <$> gparse+instance GParse U1 where gparse = return U1+instance Parse a => GParse (K1 i a) where gparse = K1 <$> parseValue++instance (GParse f, GParse g) => GParse (f :*: g) where+ gparse = (:*:) <$> gparse <*> gparse++instance GParseAlts f => GParse (M1 D i f) where+ gparse =+ do con <- P.identifier configLexer+ M1 <$> gparseAlts con++------------------------------------------------------------------------++class GParseAlts f where+ gparseAlts :: String -> Parser (f a)++instance (Constructor i, GParse f) => GParseAlts (M1 C i f) where+ gparseAlts con =+ do guard (con == conName (M1 Nothing :: C1 i Maybe a))+ M1 <$> gparse++instance (GParseAlts f, GParseAlts g) => GParseAlts (f :+: g) where+ gparseAlts con = L1 <$> gparseAlts con <|> R1 <$> gparseAlts con++instance GParseAlts V1 where gparseAlts _ = fail "GParse: V1"
src/Graphics/Vty/Image/Internal.hs view
@@ -38,12 +38,13 @@ txt' = if padPrefix then TL.cons '…' (TL.drop (toDrop+1) txt) else TL.drop toDrop txt (toTake,padSuffix) = clipForCharWidth rightClip txt' 0 txt'' = TL.append (TL.take toTake txt') (if padSuffix then TL.singleton '…' else TL.empty)- clipForCharWidth 0 _ n = (n, False)+ -- Note: some characters and zero-width and combining characters+ -- combine to the left, so keep taking characters even if the width+ -- is zero. clipForCharWidth w t n | TL.null t = (n, False)- | w < cw = (n, True)- | w == cw = (n+1, False)- | w > cw = clipForCharWidth (w - cw) (TL.tail t) (n + 1)+ | w < cw = (n, w /= 0)+ | otherwise = clipForCharWidth (w - cw) (TL.tail t) (n + 1) where cw = safeWcwidth (TL.head t) clipForCharWidth _ _ _ = error "clipForCharWidth applied to undefined" in txt''
src/Graphics/Vty/Input/Events.hs view
@@ -1,6 +1,8 @@+{-# Language DeriveGeneric #-} module Graphics.Vty.Input.Events where import Data.ByteString+import GHC.Generics -- | Representations of non-modifier keys. --@@ -15,17 +17,17 @@ | KUpLeft | KUpRight | KDownLeft | KDownRight | KCenter | KFun Int | KBackTab | KPrtScr | KPause | KIns | KHome | KPageUp | KDel | KEnd | KPageDown | KBegin | KMenu- deriving (Eq,Show,Read,Ord)+ deriving (Eq,Show,Read,Ord,Generic) -- | Modifier keys. Key codes are interpreted such that users are more likely to -- have Meta than Alt; for instance on the PC Linux console, 'MMeta' will -- generally correspond to the physical Alt key. data Modifier = MShift | MCtrl | MMeta | MAlt- deriving (Eq,Show,Read,Ord)+ deriving (Eq,Show,Read,Ord,Generic) -- | Mouse buttons. data Button = BLeft | BMiddle | BRight- deriving (Eq,Show,Read,Ord)+ deriving (Eq,Show,Read,Ord,Generic) -- | Events. data Event@@ -52,6 +54,6 @@ -- input (which is probably bad, so beware!) Note that the data is -- provided in raw form and you'll have to decode (e.g. as UTF-8) if -- that's what your application expects.- deriving (Eq,Show,Read,Ord)+ deriving (Eq,Show,Read,Ord,Generic) type ClassifyMap = [(String,Event)]
src/Graphics/Vty/Output/Interface.hs view
@@ -166,13 +166,20 @@ out = (if manipCursor then writeHideCursor dc else mempty) `mappend` writeOutputOps dc initialAttr diffs ops `mappend`- (case picCursor pic of+ (let (w,h) = contextRegion dc+ clampX = max 0 . min (w-1)+ clampY = max 0 . min (h-1) in+ case picCursor pic of _ | not manipCursor -> mempty- NoCursor -> mempty+ NoCursor -> mempty+ AbsoluteCursor x y ->+ writeShowCursor dc `mappend`+ writeMoveCursor dc (clampX x) (clampY y) Cursor x y -> let m = cursorOutputMap ops $ picCursor pic (ox, oy) = charToOutputPos m (x,y)- in writeShowCursor dc `mappend` writeMoveCursor dc ox oy+ in writeShowCursor dc `mappend`+ writeMoveCursor dc (clampX ox) (clampY oy) ) -- ... then serialize outputByteBuffer (contextDevice dc) (writeToByteString out)
src/Graphics/Vty/Picture.hs view
@@ -69,13 +69,16 @@ -- -- todo: The Cursor can be given a (character,row) offset outside of the visible bounds of the -- output region. In this case the cursor will not be shown.-data Cursor = +data Cursor =+ -- | Hide the cursor NoCursor- | Cursor Int Int+ -- | Show the cursor at the given logical column accounting for char width and row+ | Cursor !Int !Int+ -- | Show the cursor at the given absolute terminal column and row+ | AbsoluteCursor !Int !Int instance NFData Cursor where- rnf NoCursor = ()- rnf (Cursor w h) = w `seq` h `seq` ()+ rnf c = c `seq` () -- | A 'Picture' has a background pattern. The background is either ClearBackground. Which shows the -- layer below or is blank if the bottom layer. Or the background pattern is a character and a@@ -85,11 +88,11 @@ -- \todo The current attribute is always set to the default attributes at the start of updating the -- screen to a picture. data Background- = Background + = Background { backgroundChar :: Char , backgroundAttr :: Attr }- -- | A ClearBackground is: + -- | A ClearBackground is: -- -- * the space character if there are remaining non-skip ops --
− test.hs
@@ -1,20 +0,0 @@-import Control.Exception (bracket)-import Graphics.Vty--main :: IO ()-main =- bracket (mkVty mempty) shutdown $ \vty ->- do a <- supportsBell (outputIface vty)- update vty (picForImage (string defAttr $ show a))- loop vty --loop :: Vty -> IO ()-loop vty =- do ev <- nextEvent vty - case ev of- EvKey KEsc _ -> return ()- EvKey (KChar 'p') _ -> putStrLn "bad news" >> loop vty - EvKey (KChar 'l') _ -> refresh vty >> loop vty- EvKey (KChar 'b') _ -> ringTerminalBell (outputIface vty) >> loop vty- _ -> loop vty-
test/VerifyConfig.hs view
@@ -6,13 +6,14 @@ import Data.Default import Data.String.QQ+import qualified Data.ByteString.Char8 as B import Test.Framework import Test.Framework.Providers.HUnit import Test.HUnit hiding (Test) -exampleConfig :: String-exampleConfig = [s|+exampleConfig :: B.ByteString+exampleConfig = B.pack [s| -- comments should be ignored. map _ "\ESC[B" KUp [] askfjla dfasjdflk jasdlkfj asdfj -- lines failing parse should be ignored@@ -33,9 +34,10 @@ } exampleConfigParses :: IO ()-exampleConfigParses = assertEqual "example config parses as expected"- exampleConfigConfig- (runParseConfig "exampleConfig" exampleConfig)+exampleConfigParses =+ assertEqual "example config parses as expected"+ exampleConfigConfig+ (runParseConfig "exampleConfig" exampleConfig) main :: IO () main = defaultMain
vty.cabal view
@@ -1,5 +1,5 @@ name: vty-version: 5.9.1+version: 5.10 license: BSD3 license-file: LICENSE author: AUTHORS@@ -128,21 +128,6 @@ ghc-prof-options: -O2 -funbox-strict-fields -caf-all -Wall -fspec-constr -fspec-constr-count=10 cc-options: -O2--executable vty-bell-demo- main-is: test.hs-- default-language: Haskell2010- default-extensions: ScopedTypeVariables- ghc-options: -threaded-- build-depends: vty,- base >= 4 && < 5,- containers,- data-default >= 0.5.3,- microlens,- microlens-mtl,- mtl >= 1.1.1.0 && < 2.3 executable vty-mode-demo main-is: ModeDemo.hs