@@ -1,3 +1,4 @@
1+{-# LANGUAGE ScopedTypeVariables #-}
1-- Copyright 2009-2010 Corey O'Connor
2-- Copyright 2009-2010 Corey O'Connor
2{-# OPTIONS_GHC -Wall #-}
3{-# OPTIONS_GHC -Wall #-}
3{-# LANGUAGE ForeignFunctionInterface #-}
4{-# LANGUAGE ForeignFunctionInterface #-}
@@ -33,7 +34,7 @@ import System.Posix.IO ( stdInput
33 ,FdOption(..)
34 ,FdOption(..)
36−import Foreign ( malloc, poke, peek, free )
37+import Foreign ( alloca, poke, peek, Ptr )
38-- |Representations of non-modifier keys.
39-- |Representations of non-modifier keys.
39data Key = KEsc | KFun Int | KBackTab | KPrtScr | KPause | KASCII Char | KBS | KIns
40data Key = KEsc | KFun Int | KBackTab | KPrtScr | KPause | KASCII Char | KBS | KIns
@@ -76,32 +77,34 @@ initTermInput escDelay terminal = do
76 where loop kb = case (classify kb) of
77 where loop kb = case (classify kb) of
77 Prefix -> do c <- readChan inputChannel
78 Prefix -> do c <- readChan inputChannel
78 loop (kb ++ [c])
79 loop (kb ++ [c])
80+ Invalid -> do c <- readChan inputChannel
79− Invalid -> loop ""
81+ loop [c]
80 MisPfx k m s -> writeChan eventChannel (EvKey k m) >> loop s
82 MisPfx k m s -> writeChan eventChannel (EvKey k m) >> loop s
81 Valid k m -> writeChan eventChannel (EvKey k m) >> loop ""
83 Valid k m -> writeChan eventChannel (EvKey k m) >> loop ""
83 finishAtomicInput = writeChan inputChannel '\xFFFE'
85 finishAtomicInput = writeChan inputChannel '\xFFFE'
85 inputThread :: IO ()
87 inputThread :: IO ()
86− inputThread = loop
88+ inputThread = do
87− where
89+ _ <- alloca $ \(input_buffer :: Ptr Word8) -> do
88− loop = do
90+ let loop = do
89− setFdOption stdInput NonBlockingRead False
91+ setFdOption stdInput NonBlockingRead False
90− threadWaitRead stdInput
92+ threadWaitRead stdInput
91− setFdOption stdInput NonBlockingRead True
93+ setFdOption stdInput NonBlockingRead True
92− _ <- try readAll :: IO (Either IOException ())
94+ _ <- try readAll :: IO (Either IOException ())
93− when (escDelay == 0) finishAtomicInput
95+ when (escDelay == 0) finishAtomicInput
95− readAll = do
97+ readAll = do
97− poke ptr 0
98+ poke input_buffer 0
98− bytes_read <- fdReadBuf stdInput ptr 1
99+ bytes_read <- fdReadBuf stdInput input_buffer 1
99− bytes <- fmap ((: "") . chr . fromIntegral) $ peek ptr
100+ input_char <- fmap (chr . fromIntegral) $ peek input_buffer
101− when (bytes_read > 0) $ do
101+ when (bytes_read > 0) $ do
102− _ <- tryPutMVar hadInput () -- signal input
102+ _ <- tryPutMVar hadInput () -- signal input
103− writeChan inputChannel (head bytes)
103+ writeChan inputChannel input_char
105 -- | If there is no input for some time, this thread puts '\xFFFE' in the
108 -- | If there is no input for some time, this thread puts '\xFFFE' in the
106 -- inputChannel.
109 -- inputChannel.
107 noInputThread :: IO ()
110 noInputThread :: IO ()
@@ -110,6 +113,7 @@ initTermInput escDelay terminal = do
110 takeMVar hadInput -- wait for some input
113 takeMVar hadInput -- wait for some input
111 threadDelay escDelay -- microseconds
114 threadDelay escDelay -- microseconds
112 hadNoInput <- isEmptyMVar hadInput -- no input yet?
115 hadNoInput <- isEmptyMVar hadInput -- no input yet?
116+ -- TODO(corey): there is a race between here and the inputThread.
113 when hadNoInput $ do
117 when hadNoInput $ do
114 finishAtomicInput
118 finishAtomicInput
@@ -224,6 +228,7 @@ initTermInput escDelay terminal = do
224 writeChan eventChannel (EvResize e e))
228 writeChan eventChannel (EvResize e e))
225 _ <- installHandler windowChange pokeIO Nothing
229 _ <- installHandler windowChange pokeIO Nothing
226 _ <- installHandler continueProcess pokeIO Nothing
230 _ <- installHandler continueProcess pokeIO Nothing
231+ -- TODO(corey): killThread is a bit risky for my tastes.
227 let uninit = do killThread eventThreadId
232 let uninit = do killThread eventThreadId
228 killThread inputThreadId
233 killThread inputThreadId
229 killThread noInputThreadId
234 killThread noInputThreadId