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