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
5module Graphics.Vty.Input.Mouse
6  ( requestMouseEvents
7  , disableMouseEvents
8  , isMouseEvent
9  , classifyMouseEvent
10  )
11where
12
13import Graphics.Vty.Input.Events
14import Graphics.Vty.Input.Classify.Types
15import Graphics.Vty.Input.Classify.Parse
16
17import Control.Monad.State
18import Data.List (isPrefixOf)
19import Data.Maybe (catMaybes)
20import 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.
35requestMouseEvents :: String
36requestMouseEvents = "\ESC[?1000h\ESC[?1002h\ESC[?1006h"
37
38-- | These sequences disable mouse events.
39disableMouseEvents :: String
40disableMouseEvents = "\ESC[?1000l\ESC[?1002l\ESC[?1006l"
41
42-- | Does the specified string begin with a mouse event?
43isMouseEvent :: String -> Bool
44isMouseEvent s = isSGREvent s || isNormalEvent s
45
46isSGREvent :: String -> Bool
47isSGREvent = isPrefixOf sgrPrefix
48
49sgrPrefix :: String
50sgrPrefix = "\ESC[M"
51
52isNormalEvent :: String -> Bool
53isNormalEvent = isPrefixOf normalPrefix
54
55normalPrefix :: String
56normalPrefix = "\ESC[<"
57
58-- Modifier bits:
59shiftBit :: Int
60shiftBit = 4
61
62metaBit :: Int
63metaBit = 8
64
65ctrlBit :: Int
66ctrlBit = 16
67
68-- These bits indicate the buttons involved:
69buttonMask :: Int
70buttonMask = 67
71
72leftButton :: Int
73leftButton = 0
74
75middleButton :: Int
76middleButton = 1
77
78rightButton :: Int
79rightButton = 2
80
81scrollUp :: Int
82scrollUp = 64
83
84scrollDown :: Int
85scrollDown = 65
86
87hasBitSet :: Int -> Int -> Bool
88hasBitSet val bit = val .&. bit > 0
89
90-- | Attempt to lassify an input string as a mouse event.
91classifyMouseEvent :: String -> KClass
92classifyMouseEvent s = runParser s $ do
93    when (not $ isMouseEvent s) failParse
94
95    expectChar '\ESC'
96    expectChar '['
97    ty <- readChar
98    case ty of
99        '<' -> classifySGRMouseEvent
100        'M' -> classifyNormalMouseEvent
101        _   -> failParse
102
103-- Given a modifer/button value, determine which button was indicated
104getSGRButton :: Int -> Parser Button
105getSGRButton mods =
106    let buttonMap = [ (leftButton,   BLeft)
107                    , (middleButton, BMiddle)
108                    , (rightButton,  BRight)
109                    , (scrollUp,     BScrollUp)
110                    , (scrollDown,   BScrollDown)
111                    ]
112    in case lookup (mods .&. buttonMask) buttonMap of
113        Nothing -> failParse
114        Just b -> return b
115
116getModifiers :: Int -> [Modifier]
117getModifiers mods =
118    catMaybes [ if mods `hasBitSet` shiftBit then Just MShift else Nothing
119              , if mods `hasBitSet` metaBit  then Just MMeta  else Nothing
120              , if mods `hasBitSet` ctrlBit  then Just MCtrl  else Nothing
121              ]
122
123-- Attempt to classify a control sequence as a "normal" mouse event. To
124-- get here we should have already read "\ESC[M" so that will not be
125-- included in the string to be parsed.
126classifyNormalMouseEvent :: Parser Event
127classifyNormalMouseEvent = do
128    statusChar <- readChar
129    xCoordChar <- readChar
130    yCoordChar <- readChar
131
132    let xCoord = fromEnum xCoordChar - 32
133        yCoord = fromEnum yCoordChar - 32
134        status = fromEnum statusChar
135        modifiers = getModifiers status
136
137    let press = status .&. buttonMask /= 3
138    case press of
139            True -> do
140                button <- getSGRButton status
141                return $ EvMouseDown (xCoord-1) (yCoord-1) button modifiers
142            False -> return $ EvMouseUp (xCoord-1) (yCoord-1) Nothing
143
144-- Attempt to classify a control sequence as an SGR mouse event. To
145-- get here we should have already read "\ESC[<" so that will not be
146-- included in the string to be parsed.
147classifySGRMouseEvent :: Parser Event
148classifySGRMouseEvent = do
149    mods <- readInt
150    expectChar ';'
151    xCoord <- readInt
152    expectChar ';'
153    yCoord <- readInt
154    final <- readChar
155
156    let modifiers = getModifiers mods
157    button <- getSGRButton mods
158    case final of
159        'M' -> return $ EvMouseDown (xCoord-1) (yCoord-1) button modifiers
160        'm' -> return $ EvMouseUp   (xCoord-1) (yCoord-1) (Just button)
161        _ -> failParse
162