git.iko.soy/vty
on 8c8ee2a help sign in
vty/src/Graphics/Vty/Input.hs
129 lines 5.2 kB history raw
1-- Copyright 2009-2010 Corey O'Connor
2--
3-- There are two input modes:
4-- 1. 7 bit
5-- 2. 8 bit
6--
7-- Which is better? Well, depends on if you want to enter Unicode as UTF-8 or not.
8--
9-- * 7 bit mode: UTF-8 can be input unambiguiously. Requires an escape delay to differentiate ESC
10-- from extended control characters. EG: F1
11-- * 8 bit mode: UTF-8 cannot be input. Does not require an escape delay.
12--
13-- By default 7 bit mode is used. If 8 bit moe is requested then vty will request 8 bit mode from
14-- the terminal. However, if the terminal does not report a capability that uses 8 bit encoding the
15-- mode will fall back to 7 bit.
16--
17-- By default, the escape delay is 10000 microseconds. Which is assumed to be well above the
18-- sampling rate required to detect a keyup for a person typing 200 wpm.
19--
20-- 0. set raw mode with min == 0 and time == 0
21--
22module Graphics.Vty.Input ( Key(..)
23 , Modifier(..)
24 , Button(..)
25 , Event(..)
26 , initTermInput
27 , defaultEscDelay
28 )
29 where
31import Graphics.Vty.Input.Data
32import Graphics.Vty.Input.Internal
33import Graphics.Vty.Input.Terminfo
35import Data.Char
36import Data.IORef
37import Data.Word
39import Control.Monad (when, void)
40import Control.Concurrent
41import Control.Exception
43import qualified GHC.Event as GHC
45import System.Console.Terminfo
47import System.Posix.Signals.Exts
48import System.Posix.Terminal
49import System.Posix.IO ( stdInput
50 , fdReadBuf
51 , setFdOption
52 , FdOption(..)
53 )
55import Foreign ( alloca, poke, peek, Ptr )
57defaultEscDelay :: Int
58defaultEscDelay = 0
60-- | Set up the terminal for input. Returns a function which reads key
61-- events, and a function for shutting down the terminal access.
62initTermInput :: Int -> Terminal -> IO (IO Event, IO ())
63initTermInput escDelay terminal = do
64 eventChannel <- newChan
65 inputChannel <- newChan
66 hadInput <- newEmptyMVar
67 attr <- getTerminalAttributes stdInput
68 -- disable IXON,
69 let attr' = foldl withoutMode attr [ StartStopOutput, KeyboardInterrupts
70 , EnableEcho, ProcessInput, ExtendedFunctions
71 ]
72 setTerminalAttributes stdInput attr' Immediately
73 set_term_timing
74 let finishAtomicInput = writeChan inputChannel '\xFFFE'
75 inputThread :: IO ()
76 inputThread = do
77 _ <- alloca $ \(input_buffer :: Ptr Word8) -> do
78 let loop = do
79 setFdOption stdInput NonBlockingRead False
80 threadWaitRead stdInput
81 setFdOption stdInput NonBlockingRead True
82 _ <- try readAll :: IO (Either IOException ())
83 when (escDelay == 0) finishAtomicInput
84 loop
85 readAll = do
86 poke input_buffer 0
87 bytes_read <- fdReadBuf stdInput input_buffer 1
88 input_char <- fmap (chr . fromIntegral) $ peek input_buffer
89 when (bytes_read > 0) $ do
90 _ <- tryPutMVar hadInput () -- signal input
91 writeChan inputChannel input_char
92 readAll
93 loop
94 return ()
95 -- | If there is no input for some time, this thread puts '\xFFFE' in the
96 -- inputChannel.
97 noInputThread :: IO ()
98 noInputThread = when (escDelay > 0) loop
99 where loop = do
100 takeMVar hadInput -- wait for some input
101 threadDelay escDelay -- microseconds
102 hadNoInput <- isEmptyMVar hadInput -- no input yet?
103 -- TODO(corey): there is a race between here and the inputThread.
104 when hadNoInput finishAtomicInput
105 loop
107 caps_legacy_table = map_to_legacy_table $ caps_classify_table terminal keys_from_caps_table
108 term_event_classify_table = concat $ caps_legacy_table : ansi_classify_table
109 term_event_classifier = classify term_event_classify_table
111 eventThreadId <- forkIO $ void $ inputToEventThread term_event_classifier inputChannel eventChannel
112 inputThreadId <- forkIO $ inputThread
113 noInputThreadId <- forkIO $ noInputThread
114 let pokeIO = Catch $ do
115 let e = error "(getsize in input layer)"
116 setTerminalAttributes stdInput attr' Immediately
117 writeChan eventChannel (EvResize e e)
118 _ <- installHandler windowChange pokeIO Nothing
119 _ <- installHandler continueProcess pokeIO Nothing
120 -- TODO(corey): killThread is a bit risky for my tastes.
121 let uninit = do
122 killThread eventThreadId
123 killThread inputThreadId
124 killThread noInputThreadId
125 _ <- installHandler windowChange Ignore Nothing
126 _ <- installHandler continueProcess Ignore Nothing
127 setTerminalAttributes stdInput attr Immediately
128 return (readChan eventChannel, uninit)