summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authortv <tv@shackspace.de>2014-12-30 17:14:06 +0100
committertv <tv@shackspace.de>2014-12-30 17:14:06 +0100
commitc2d510ad09e13586332981280c068d5c12075905 (patch)
tree8d4d66afbf9f806e429bc6f025aaf5288100ce5b
parent7dc742185ada3808946122225a21b1e0ebff2adf (diff)
add VT200 mouse support
-rw-r--r--Event.hs17
-rw-r--r--Scanner.hs30
-rw-r--r--test5.hs72
3 files changed, 98 insertions, 21 deletions
diff --git a/Event.hs b/Event.hs
index a0d43b7..f316c13 100644
--- a/Event.hs
+++ b/Event.hs
@@ -1,6 +1,4 @@
-module Event
- ( Event (..)
- ) where
+module Event where
import Trammel
@@ -8,7 +6,18 @@ import Trammel
data Event =
EFlash (Trammel String) |
EKey String |
- EMouse Char Int Int | -- TODO s/Char/..
+ EMouse MouseInfo |
EReload |
EResize Int Int
deriving Show
+
+
+data MouseInfo = MouseInfo
+ { mouseButton :: Int -- 0 = release
+ , mouseShift :: Bool
+ , mouseMeta :: Bool
+ , mouseControl :: Bool
+ , mouseX :: Int
+ , mouseY :: Int
+ }
+ deriving Show
diff --git a/Scanner.hs b/Scanner.hs
index 361a1c6..df48868 100644
--- a/Scanner.hs
+++ b/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
+ }
diff --git a/test5.hs b/test5.hs
index 5448470..d8eb0b5 100644
--- a/test5.hs
+++ b/test5.hs
@@ -16,6 +16,7 @@ import Control.Applicative
import Control.Concurrent
import Control.Exception
import Control.Monad
+import Data.List (intercalate)
import Data.Maybe
import Data.Monoid
import Data.Time
@@ -68,33 +69,41 @@ initState = do
main :: IO ()
-main = finally startup cleanup
+main =
+ finally (startup decset decrst)
+ (cleanup decset decrst)
+ where
+ decset =
+ 1000 : -- X & Y on button press and release
+ 1005 : -- UTF-8 mouse mode
+ 1049 : -- use cleared alternate screen buffer
+ []
+ decrst =
+ 25 : -- hide cursor
+ []
-cleanup :: IO ()
-cleanup = do
- hPutStr stdout "\ESC[?25h"
- hPutStr stdout "\ESC[?1049l"
+cleanup :: [Int] -> [Int] -> IO ()
+cleanup decset decrst = do
+ hSetEcho stdin True
+ hPutStr stdout $ "\ESC[?" ++ intercalate ";" (map show decset) ++ "l"
+ hPutStr stdout $ "\ESC[?" ++ intercalate ";" (map show decrst) ++ "h"
-startup :: IO ()
-startup = do
+startup :: [Int] -> [Int] -> IO ()
+startup decset decrst = do
-- load-env hack
maybe (return ()) (setEnv "HOME") =<< lookupEnv "OLDHOME"
- hSetEcho stdin False
hSetBuffering stdin NoBuffering
hSetBuffering stdout (BlockBuffering $ Just 4096)
- q0@State{..} <- initState
+ hSetEcho stdin False
+ hPutStr stdout $ "\ESC[?" ++ intercalate ";" (map show decset) ++ "h"
+ hPutStr stdout $ "\ESC[?" ++ intercalate ";" (map show decrst) ++ "l"
- --hSetEcho stdin False
- --hSetBuffering stdin NoBuffering
- -- Save Cursor and use Alternate Screen Buffer
- hPutStr stdout "\ESC[?1049h"
- -- Hide Cursor
- hPutStr stdout "\ESC[?25l"
+ q0@State{..} <- initState
(putEvent, getEvent) <- do
v <- newEmptyMVar
@@ -138,6 +147,7 @@ run getEvent = rec where
redraw q' >> getEvent >>= processEvent q'
+-- TODO merge EKey and EMouse?
processEvent :: State -> Event -> IO State
processEvent q = \case
EFlash t ->
@@ -148,6 +158,12 @@ processEvent q = \case
a q
Nothing ->
return q { flashMessage = Plain $ show s }
+ EMouse info ->
+ case mousemap info of
+ Just a ->
+ a q
+ Nothing ->
+ return q { flashMessage = SGR [38,5,202] $ Plain $ show info }
EResize w h ->
return q
{ screenWidth = w, screenHeight = h
@@ -225,6 +241,32 @@ keymap "\ESC[>85;95;0c" = Just $ \q -> return q { flashMessage = flashMessage q
keymap _ = Nothing
+mousemap :: MouseInfo -> Maybe (State -> IO State)
+
+mousemap MouseInfo{mouseButton=4} = Just $ moveTreeDown 3
+mousemap MouseInfo{mouseButton=5} = Just $ moveTreeUp 3
+
+mousemap MouseInfo{mouseButton=1,mouseY=y} = Just $ \q@State{..} -> do
+ let linearClickPos =
+ let i = (y - length headBuffer + yoffset) - 1 {-zero-based-}
+ in if 0 <= i && i < length treeBuffer
+ then Just i
+ else Nothing
+ case linearClickPos of
+ Nothing ->
+ return q
+ { flashMessage = Plain $ "nothing to click"
+ }
+ Just i ->
+ return q
+ { cursor = findNextN i $ Z.root cursor
+ }
+
+mousemap MouseInfo{mouseButton=0} = Just return
+
+mousemap _ = Nothing
+
+
topOverrun :: State -> Int
topOverrun State{..} =