diff options
author | tv <tv@shackspace.de> | 2014-12-30 17:14:06 +0100 |
---|---|---|
committer | tv <tv@shackspace.de> | 2015-10-17 02:12:32 +0200 |
commit | c993c22437495ac65c129ad642cd2bed2d242db0 (patch) | |
tree | f143faa7ae903d14894a73773734aedd7b5fb98a | |
parent | a5a3f35da8d06ee4e5db4bc4ebc29b4c60fec6fe (diff) |
add VT200 mouse support
-rw-r--r-- | src/Scanner.hs | 30 |
1 files changed, 28 insertions, 2 deletions
diff --git a/src/Scanner.hs b/src/Scanner.hs index 361a1c6..df48868 100644 --- a/src/Scanner.hs +++ b/src/Scanner.hs @@ -4,7 +4,9 @@ module Scanner ( scan ) where +import Data.Bits ((.&.), testBit) import Data.Char (ord) +import Data.Word (Word8) import Event import System.IO (Handle, hGetChar, hLookAhead, hWaitForInput) @@ -48,12 +50,11 @@ scanCS h = Nothing -> return $ EKey "\ESC" -- TODO move this to scanESC Just c | c == 'M' -> do - -- VT200 mouse _ <- hGetChar h -- drop 'M' b <- hGetChar h x <- hGetChar h y <- hGetChar h - return $ EMouse b (ord x - 32) (ord y - 32) + return $ parseNormalButton b x y | otherwise -> zeroOrMore h parameterByte ['[', '\ESC'] >>= zeroOrMore h intermediateByte >>= @@ -113,3 +114,28 @@ hWaitLookAhead t h = do if ready then hLookAhead h >>= return . Just else return Nothing + + +parseNormalButton :: Char -> Char -> Char -> Event +parseNormalButton cb cx cy = do + let b = fromIntegral $ ord cb :: Word8 + x = ord cx - 32 + y = ord cy - 32 + button = case (b .&. 3) + (b .&. 64) of + 0 -> 1 + 1 -> 2 + 2 -> 3 + 3 -> 0 -- release + 64 -> 4 -- wheel up + 65 -> 5 -- wheel down + 66 -> 6 -- wheel left + 67 -> 7 -- wheel right + _ -> error "TODO proper parseNormalButton error" + EMouse $ MouseInfo + { mouseButton = button + , mouseShift = testBit b 2 + , mouseMeta = testBit b 3 + , mouseControl = testBit b 4 + , mouseX = x + , mouseY = y + } |