git.iko.soy/vty
on ffe6de2 help sign in
vty/src/Graphics/Vty/Input.hs
106 lines 4.3 kB history raw
1-- Copyright 2009-2010 Corey O'Connor
2module Graphics.Vty.Input ( Key(..)
3 , Modifier(..)
4 , Button(..)
5 , Event(..)
6 , initTermInput
7 , defaultEscDelay
8 )
9 where
11import Graphics.Vty.Input.Data
12import Graphics.Vty.Input.Internal
13import Graphics.Vty.Input.Terminfo
15import Data.Char
16import Data.Word
18import Control.Monad (when, void)
19import Control.Concurrent
20import Control.Exception
22import System.Console.Terminfo
24import System.Posix.Signals.Exts
25import System.Posix.Terminal
26import System.Posix.IO ( stdInput
27 , fdReadBuf
28 , setFdOption
29 , FdOption(..)
30 )
32import Foreign ( alloca, poke, peek, Ptr )
34defaultEscDelay :: Int
35defaultEscDelay = 0
37-- | Set up the terminal for input. Returns a function which reads key
38-- events, and a function for shutting down the terminal access.
39initTermInput :: Int -> Terminal -> IO (IO Event, IO ())
40initTermInput escDelay terminal = do
41 eventChannel <- newChan
42 inputChannel <- newChan
43 hadInput <- newEmptyMVar
44 oattr <- getTerminalAttributes stdInput
45 let nattr = foldl withoutMode oattr [ StartStopOutput, KeyboardInterrupts
46 , EnableEcho, ProcessInput, ExtendedFunctions
47 ]
48 setTerminalAttributes stdInput nattr Immediately
49 set_term_timing
50 let finishAtomicInput = writeChan inputChannel '\xFFFE'
51 inputThread :: IO ()
52 inputThread = do
53 _ <- alloca $ \(input_buffer :: Ptr Word8) -> do
54 let loop = do
55 setFdOption stdInput NonBlockingRead False
56 threadWaitRead stdInput
57 setFdOption stdInput NonBlockingRead True
58 _ <- try readAll :: IO (Either IOException ())
59 when (escDelay == 0) finishAtomicInput
60 loop
61 readAll = do
62 poke input_buffer 0
63 bytes_read <- fdReadBuf stdInput input_buffer 1
64 input_char <- fmap (chr . fromIntegral) $ peek input_buffer
65 when (bytes_read > 0) $ do
66 _ <- tryPutMVar hadInput () -- signal input
67 writeChan inputChannel input_char
68 readAll
69 loop
70 return ()
71 -- | If there is no input for some time, this thread puts '\xFFFE' in the
72 -- inputChannel.
73 noInputThread :: IO ()
74 noInputThread = when (escDelay > 0) loop
75 where loop = do
76 takeMVar hadInput -- wait for some input
77 threadDelay escDelay -- microseconds
78 hadNoInput <- isEmptyMVar hadInput -- no input yet?
79 -- TODO(corey): there is a race between here and the inputThread.
80 when hadNoInput $ do
81 finishAtomicInput
82 loop
84 caps_legacy_table = map_to_legacy_table $ caps_classify_table terminal keys_from_caps_table
85 term_event_classify_table = concat $ caps_legacy_table : ansi_classify_table
86 term_event_classifier = classify term_event_classify_table
88 eventThreadId <- forkIO $ void $ inputToEventThread term_event_classifier inputChannel eventChannel
89 inputThreadId <- forkIO $ inputThread
90 noInputThreadId <- forkIO $ noInputThread
91 let pokeIO = Catch $ do
92 let e = error "(getsize in input layer)"
93 setTerminalAttributes stdInput nattr Immediately
94 writeChan eventChannel (EvResize e e)
95 _ <- installHandler windowChange pokeIO Nothing
96 _ <- installHandler continueProcess pokeIO Nothing
97 -- TODO(corey): killThread is a bit risky for my tastes.
98 let uninit = do
99 killThread eventThreadId
100 killThread inputThreadId
101 killThread noInputThreadId
102 _ <- installHandler windowChange Ignore Nothing
103 _ <- installHandler continueProcess Ignore Nothing
104 setTerminalAttributes stdInput oattr Immediately
105 return (readChan eventChannel, uninit)