From c993c22437495ac65c129ad642cd2bed2d242db0 Mon Sep 17 00:00:00 2001
From: tv <tv@shackspace.de>
Date: Tue, 30 Dec 2014 17:14:06 +0100
Subject: add VT200 mouse support

---
 src/Scanner.hs | 30 ++++++++++++++++++++++++++++--
 1 file changed, 28 insertions(+), 2 deletions(-)

(limited to 'src')

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
+        }
-- 
cgit v1.2.3