git.iko.soy/vty
on master help sign in
Merge mouse support
405ca96Jonathan Daugherty
README.md+3
compare with master
unifiedsplit
@@ -68,6 +68,9 @@ cabal install vty
68* Uses the TIOCGWINSZ ioctl to find the current window size, which appears to be
68* Uses the TIOCGWINSZ ioctl to find the current window size, which appears to be
69 limited to Linux and BSD.
69 limited to Linux and BSD.
70
70
71+* Supports "normal" and "extended" (SGR) mouse modes as described at
72+ http://invisible-island.net/xterm/ctlseqs/ctlseqs.html#h2-Mouse-Tracking
73+
71# Platform Support
74# Platform Support
72
75
73## Posix Terminals
76## Posix Terminals
src/Graphics/Vty/Input/Classify.hs+3−6
@@ -12,6 +12,8 @@ module Graphics.Vty.Input.Classify
12 ) where
12 ) where
13
13
14import Graphics.Vty.Input.Events
14import Graphics.Vty.Input.Events
15+import Graphics.Vty.Input.Mouse
16+import Graphics.Vty.Input.Classify.Types
15
17
16import Codec.Binary.UTF8.Generic (decode)
18import Codec.Binary.UTF8.Generic (decode)
17
19
@@ -23,12 +25,6 @@ import qualified Data.Set as S( fromList, member )
23import Data.Char
25import Data.Char
24import Data.Word
26import Data.Word
25
27
26−data KClass
27− = Valid Event [Char]
28− | Invalid
29− | Prefix
30− deriving(Show, Eq)
31−
32compile :: ClassifyMap -> [Char] -> KClass
28compile :: ClassifyMap -> [Char] -> KClass
33compile table = cl' where
29compile table = cl' where
34 -- take all prefixes and create a set of these
30 -- take all prefixes and create a set of these
@@ -64,6 +60,7 @@ classify table =
64 if bracketedPasteFinished s
60 if bracketedPasteFinished s
65 then parseBracketedPaste s
61 then parseBracketedPaste s
66 else Prefix
62 else Prefix
63+ _ | isMouseEvent s -> classifyMouseEvent s
67 c:cs | ord c >= 0xC2 -> classifyUtf8 c cs
64 c:cs | ord c >= 0xC2 -> classifyUtf8 c cs
68 _ -> standardClassifier s
65 _ -> standardClassifier s
69
66
src/Graphics/Vty/Input/Classify/Parse.hsnew file+57
@@ -0,0 +1,57 @@
1+-- | This module provides a simple parser for parsing input event
2+-- control sequences.
3+module Graphics.Vty.Input.Classify.Parse
4+ ( Parser
5+ , runParser
6+ , failParse
7+ , readInt
8+ , readChar
9+ , expectChar
10+ ) where
11+
12+import Graphics.Vty.Input.Events
13+import Graphics.Vty.Input.Classify.Types
14+
15+import Control.Monad.Trans.Maybe
16+import Control.Monad.State
17+
18+type Parser a = MaybeT (State String) a
19+
20+-- | Run a parser on a given input string. If the parser fails, return
21+-- 'Invalid'. Otherwise return the valid event ('Valid') and the
22+-- remaining unparsed characters.
23+runParser :: String -> Parser Event -> KClass
24+runParser s parser =
25+ case runState (runMaybeT parser) s of
26+ (Nothing, _) -> Invalid
27+ (Just e, remaining) -> Valid e remaining
28+
29+-- | Fail a parsing operation.
30+failParse :: Parser a
31+failParse = fail "invalid parse"
32+
33+-- | Read an integer from the input stream. If an integer cannot be
34+-- read, fail parsing. E.g. calling readInt on an input of "123abc" will
35+-- return '123' and consume those characters.
36+readInt :: Parser Int
37+readInt = do
38+ s <- get
39+ case (reads :: ReadS Int) s of
40+ [(i, rest)] -> put rest >> return i
41+ _ -> failParse
42+
43+-- | Read a character from the input stream. If one cannot be read (e.g.
44+-- we are out of characters), fail parsing.
45+readChar :: Parser Char
46+readChar = do
47+ s <- get
48+ case s of
49+ c:rest -> put rest >> return c
50+ _ -> failParse
51+
52+-- | Read a character from the input stream and fail parsing if it is
53+-- not the specified character.
54+expectChar :: Char -> Parser ()
55+expectChar c = do
56+ c' <- readChar
57+ if c' == c then return () else failParse
src/Graphics/Vty/Input/Classify/Types.hsnew file+18
@@ -0,0 +1,18 @@
1+-- | This module exports the input classification type to avoid import
2+-- cycles between other modules that need this.
3+module Graphics.Vty.Input.Classify.Types
4+ ( KClass(..)
5+ ) where
6+
7+import Graphics.Vty.Input.Events
8+
9+data KClass
10+ = Valid Event [Char]
11+ -- ^ A valid event was parsed. Any unused characters from the input
12+ -- stream are also provided.
13+ | Invalid
14+ -- ^ The input characters did not represent a valid event.
15+ | Prefix
16+ -- ^ The input characters form the prefix of a valid event character
17+ -- sequence.
18+ deriving(Show, Eq)
src/Graphics/Vty/Input/Events.hs+13−7
@@ -22,20 +22,26 @@ data Modifier = MShift | MCtrl | MMeta | MAlt
22 deriving (Eq,Show,Read,Ord)
22 deriving (Eq,Show,Read,Ord)
23
23
24-- | Mouse buttons.
24-- | Mouse buttons.
25−--
26−-- \todo not supported.
27data Button = BLeft | BMiddle | BRight
25data Button = BLeft | BMiddle | BRight
28 deriving (Eq,Show,Read,Ord)
26 deriving (Eq,Show,Read,Ord)
29
27
30-- | Events.
28-- | Events.
31data Event
29data Event
32 = EvKey Key [Modifier]
30 = EvKey Key [Modifier]
33− -- | \todo mouse events are not supported
31+ -- ^ A keyboard key was pressed with the specified modifiers.
34− | EvMouse Int Int Button [Modifier]
32+ | EvMouseDown Int Int Button [Modifier]
35− -- | if read from 'eventChannel' this is the size at the time of the signal. If read from
33+ -- ^ A mouse button was pressed at the specified column and row. Any
36− -- 'nextEvent' this is the size at the time the event was processed by Vty. Typically these are
34+ -- modifiers available in the event are also provided.
37− -- the same, but if somebody is resizing the terminal quickly they can be different.
35+ | EvMouseUp Int Int (Maybe Button)
36+ -- ^ A mouse button was released at the specified column and
37+ -- row. Some terminals report only that a button was released
38+ -- without specifying which one; in that case, Nothing is provided.
39+ -- Otherwise Just the button released is included in the event.
38 | EvResize Int Int
40 | EvResize Int Int
41+ -- ^ If read from 'eventChannel' this is the size at the time of the
42+ -- signal. If read from 'nextEvent' this is the size at the time the
43+ -- event was processed by Vty. Typically these are the same, but if
44+ -- somebody is resizing the terminal quickly they can be different.
39 | EvPaste String
45 | EvPaste String
40 -- ^ A paste event occurs when a bracketed paste input sequence is
46 -- ^ A paste event occurs when a bracketed paste input sequence is
41 -- received. For terminals that support bracketed paste mode, these
47 -- received. For terminals that support bracketed paste mode, these
src/Graphics/Vty/Input/Mouse.hsnew file+153
@@ -0,0 +1,153 @@
1+-- | This module provides parsers for mouse events for both "normal" and
2+-- "extended" modes. This implementation was informed by
3+--
4+-- http://invisible-island.net/xterm/ctlseqs/ctlseqs.html#h2-Mouse-Tracking
5+module Graphics.Vty.Input.Mouse
6+ ( requestMouseEvents
7+ , disableMouseEvents
8+ , isMouseEvent
9+ , classifyMouseEvent
10+ ) where
11+
12+import Graphics.Vty.Input.Events
13+import Graphics.Vty.Input.Classify.Types
14+import Graphics.Vty.Input.Classify.Parse
15+
16+import Control.Monad.Trans.Maybe
17+import Control.Monad.State
18+import Data.List (isPrefixOf)
19+import Data.Maybe (catMaybes)
20+import Data.Bits ((.&.))
21+
22+-- A mouse event in SGR extended mode is
23+--
24+-- '\ESC' '[' '<' B ';' X ';' Y ';' ('M'|'m')
25+--
26+-- where
27+--
28+-- * B is the number with button and modifier bits set,
29+-- * X is the X coordinate of the event starting at 1
30+-- * Y is the Y coordinate of the event starting at 1
31+-- * the final character is 'M' for a press, 'm' for a release
32+
33+-- | These sequences set xterm-based terminals to send mouse event
34+-- sequences.
35+requestMouseEvents :: String
36+requestMouseEvents = "\ESC[?1000h\ESC[?1002h\ESC[?1006h\ESC[?1005h"
37+
38+-- | These sequences disable mouse events.
39+disableMouseEvents :: String
40+disableMouseEvents = "\ESC[?1000l\ESC[?1002l\ESC[?1006l\ESC[?1005l"
41+
42+-- | Does the specified string begin with a mouse event?
43+isMouseEvent :: String -> Bool
44+isMouseEvent s = isSGREvent s || isNormalEvent s
45+
46+isSGREvent :: String -> Bool
47+isSGREvent = isPrefixOf sgrPrefix
48+
49+sgrPrefix :: String
50+sgrPrefix = "\ESC[M"
51+
52+isNormalEvent :: String -> Bool
53+isNormalEvent = isPrefixOf normalPrefix
54+
55+normalPrefix :: String
56+normalPrefix = "\ESC[<"
57+
58+-- Modifier bits:
59+shiftBit :: Int
60+shiftBit = 4
61+
62+metaBit :: Int
63+metaBit = 8
64+
65+ctrlBit :: Int
66+ctrlBit = 16
67+
68+-- These bits indicate the buttons involved:
69+buttonMask :: Int
70+buttonMask = 3
71+
72+leftButton :: Int
73+leftButton = 0
74+
75+middleButton :: Int
76+middleButton = 1
77+
78+rightButton :: Int
79+rightButton = 2
80+
81+hasBitSet :: Int -> Int -> Bool
82+hasBitSet val bit = val .&. bit > 0
83+
84+-- | Attempt to lassify an input string as a mouse event.
85+classifyMouseEvent :: String -> KClass
86+classifyMouseEvent s = runParser s $ do
87+ when (not $ isMouseEvent s) failParse
88+
89+ expectChar '\ESC'
90+ expectChar '['
91+ ty <- readChar
92+ case ty of
93+ '<' -> classifySGRMouseEvent
94+ 'M' -> classifyNormalMouseEvent
95+ _ -> failParse
96+
97+-- Given a modifer/button value, determine which button was indicated
98+getSGRButton :: Int -> Parser Button
99+getSGRButton mods =
100+ let buttonMap = [ (leftButton, BLeft)
101+ , (middleButton, BMiddle)
102+ , (rightButton, BRight)
103+ ]
104+ in case lookup (mods .&. buttonMask) buttonMap of
105+ Nothing -> failParse
106+ Just b -> return b
107+
108+getModifiers :: Int -> [Modifier]
109+getModifiers mods =
110+ catMaybes [ if mods `hasBitSet` shiftBit then Just MShift else Nothing
111+ , if mods `hasBitSet` metaBit then Just MMeta else Nothing
112+ , if mods `hasBitSet` ctrlBit then Just MCtrl else Nothing
113+ ]
114+
115+-- Attempt to classify a control sequence as a "normal" mouse event. To
116+-- get here we should have already read "\ESC[M" so that will not be
117+-- included in the string to be parsed.
118+classifyNormalMouseEvent :: Parser Event
119+classifyNormalMouseEvent = do
120+ statusChar <- readChar
121+ xCoordChar <- readChar
122+ yCoordChar <- readChar
123+
124+ let xCoord = fromEnum xCoordChar - 32
125+ yCoord = fromEnum yCoordChar - 32
126+ status = fromEnum statusChar
127+ modifiers = getModifiers status
128+
129+ let press = status .&. buttonMask /= 3
130+ case press of
131+ True -> do
132+ button <- getSGRButton status
133+ return $ EvMouseDown xCoord yCoord button modifiers
134+ False -> return $ EvMouseUp xCoord yCoord Nothing
135+
136+-- Attempt to classify a control sequence as an SGR mouse event. To
137+-- get here we should have already read "\ESC[<" so that will not be
138+-- included in the string to be parsed.
139+classifySGRMouseEvent :: Parser Event
140+classifySGRMouseEvent = do
141+ mods <- readInt
142+ expectChar ';'
143+ xCoord <- readInt
144+ expectChar ';'
145+ yCoord <- readInt
146+ final <- readChar
147+
148+ let modifiers = getModifiers mods
149+ button <- getSGRButton mods
150+ case final of
151+ 'M' -> return $ EvMouseDown xCoord yCoord button modifiers
152+ 'm' -> return $ EvMouseUp xCoord yCoord (Just button)
153+ _ -> failParse
src/Graphics/Vty/Output.hs+3−3
@@ -54,14 +54,14 @@ import Data.Monoid ((<>))
54--
54--
55-- Selection of a terminal is done as follows:
55-- Selection of a terminal is done as follows:
56--
56--
57−-- * If TERM == xterm use XTermColor.
57+-- * If TERM contains "xterm" or "screen", use XTermColor.
58−-- * for any other TERM value TerminfoBased is used.
58+-- * otherwise use the TerminfoBased driver.
59--
59--
60-- \todo add an implementation for windows that does not depend on terminfo. Should be installable
60-- \todo add an implementation for windows that does not depend on terminfo. Should be installable
61-- with only what is provided in the haskell platform. Use ansi-terminal
61-- with only what is provided in the haskell platform. Use ansi-terminal
62outputForConfig :: Config -> IO Output
62outputForConfig :: Config -> IO Output
63outputForConfig Config{ outputFd = Just fd, termName = Just termName, .. } = do
63outputForConfig Config{ outputFd = Just fd, termName = Just termName, .. } = do
64− t <- if "xterm" `isPrefixOf` termName
64+ t <- if "xterm" `isPrefixOf` termName || "screen" `isPrefixOf` termName
65 then XTermColor.reserveTerminal termName fd
65 then XTermColor.reserveTerminal termName fd
66 -- Not an xterm-like terminal. try for generic terminfo.
66 -- Not an xterm-like terminal. try for generic terminfo.
67 else TerminfoBased.reserveTerminal termName fd
67 else TerminfoBased.reserveTerminal termName fd
src/Graphics/Vty/Output/XTermColor.hs+3
@@ -9,6 +9,7 @@ module Graphics.Vty.Output.XTermColor ( reserveTerminal )
9 where
9 where
10
10
11import Graphics.Vty.Output.Interface
11import Graphics.Vty.Output.Interface
12+import Graphics.Vty.Input.Mouse
12import qualified Graphics.Vty.Output.TerminfoBased as TerminfoBased
13import qualified Graphics.Vty.Output.TerminfoBased as TerminfoBased
13
14
14import Blaze.ByteString.Builder (writeToByteString)
15import Blaze.ByteString.Builder (writeToByteString)
@@ -34,12 +35,14 @@ reserveTerminal variant outFd = liftIO $ do
34 let variant' = if variant == "xterm-color" then "xterm" else variant
35 let variant' = if variant == "xterm-color" then "xterm" else variant
35 flushedPut setUtf8CharSet
36 flushedPut setUtf8CharSet
36 flushedPut enableBracketedPastes
37 flushedPut enableBracketedPastes
38+ flushedPut requestMouseEvents
37 t <- TerminfoBased.reserveTerminal variant' outFd
39 t <- TerminfoBased.reserveTerminal variant' outFd
38 let t' = t
40 let t' = t
39 { terminalID = terminalID t ++ " (xterm-color)"
41 { terminalID = terminalID t ++ " (xterm-color)"
40 , releaseTerminal = do
42 , releaseTerminal = do
41 liftIO $ flushedPut setDefaultCharSet
43 liftIO $ flushedPut setDefaultCharSet
42 liftIO $ flushedPut disableBracketedPastes
44 liftIO $ flushedPut disableBracketedPastes
45+ liftIO $ flushedPut disableMouseEvents
43 releaseTerminal t
46 releaseTerminal t
44 , mkDisplayContext = \tActual r -> do
47 , mkDisplayContext = \tActual r -> do
45 dc <- mkDisplayContext t tActual r
48 dc <- mkDisplayContext t tActual r
vty.cabal+3
@@ -94,7 +94,10 @@ library
94 Graphics.Vty.DisplayAttributes
94 Graphics.Vty.DisplayAttributes
95 Graphics.Vty.Image.Internal
95 Graphics.Vty.Image.Internal
96 Graphics.Vty.Input.Classify
96 Graphics.Vty.Input.Classify
97+ Graphics.Vty.Input.Classify.Types
98+ Graphics.Vty.Input.Classify.Parse
97 Graphics.Vty.Input.Loop
99 Graphics.Vty.Input.Loop
100+ Graphics.Vty.Input.Mouse
98 Graphics.Vty.Input.Terminfo
101 Graphics.Vty.Input.Terminfo
99 Graphics.Vty.PictureToSpans
102 Graphics.Vty.PictureToSpans
100 Graphics.Vty.Span
103 Graphics.Vty.Span