@@ -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