diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Scanner.hs | 36 |
1 files changed, 24 insertions, 12 deletions
diff --git a/src/Scanner.hs b/src/Scanner.hs index df48868..d02750e 100644 --- a/src/Scanner.hs +++ b/src/Scanner.hs @@ -2,31 +2,43 @@ module Scanner ( scan + , Scan(..) ) where import Data.Bits ((.&.), testBit) import Data.Char (ord) import Data.Word (Word8) -import Event import System.IO (Handle, hGetChar, hLookAhead, hWaitForInput) timeout :: Int timeout = 1 +data Scan = + ScanKey String + | ScanMouse + { mouseButton :: Int -- 0 = release + , mouseShift :: Bool + , mouseMeta :: Bool + , mouseControl :: Bool + , mouseX :: Int + , mouseY :: Int + } -scan :: Handle -> IO Event + + +scan :: Handle -> IO Scan scan h = hGetChar h >>= \case '\ESC' -> scanESC h - c -> return $ EKey [c] + c -> return $ ScanKey [c] -scanESC :: Handle -> IO Event +scanESC :: Handle -> IO Scan scanESC h = hWaitGetChar timeout h >>= \case - Nothing -> return $ EKey "\ESC" + Nothing -> return $ ScanKey "\ESC" Just c | c == '[' -> -- 05/11 scanCS h @@ -39,15 +51,15 @@ scanESC h = -- XXX finalByte is maybe calles somehow else here, but it's -- the same range one h finalByte ['O','\ESC'] >>= - return . EKey . reverse + return . ScanKey . reverse | otherwise -> - return $ EKey ['\ESC',c] + return $ ScanKey ['\ESC',c] -scanCS :: Handle -> IO Event +scanCS :: Handle -> IO Scan scanCS h = hWaitLookAhead timeout h >>= \case - Nothing -> return $ EKey "\ESC" -- TODO move this to scanESC + Nothing -> return $ ScanKey "\ESC" -- TODO move this to scanESC Just c | c == 'M' -> do _ <- hGetChar h -- drop 'M' @@ -59,7 +71,7 @@ scanCS h = zeroOrMore h parameterByte ['[', '\ESC'] >>= zeroOrMore h intermediateByte >>= one h finalByte >>= - return . EKey . reverse + return . ScanKey . reverse @@ -116,7 +128,7 @@ hWaitLookAhead t h = do else return Nothing -parseNormalButton :: Char -> Char -> Char -> Event +parseNormalButton :: Char -> Char -> Char -> Scan parseNormalButton cb cx cy = do let b = fromIntegral $ ord cb :: Word8 x = ord cx - 32 @@ -131,7 +143,7 @@ parseNormalButton cb cx cy = do 66 -> 6 -- wheel left 67 -> 7 -- wheel right _ -> error "TODO proper parseNormalButton error" - EMouse $ MouseInfo + ScanMouse { mouseButton = button , mouseShift = testBit b 2 , mouseMeta = testBit b 3 |