@@ -1,3 +1,4 @@
1+{-# LANGUAGE ScopedTypeVariables #-}
12-- Copyright 2009-2010 Corey O'Connor
23{-# OPTIONS_GHC -Wall #-}
34{-# LANGUAGE ForeignFunctionInterface #-}
@@ -33,7 +34,7 @@ import System.Posix.IO ( stdInput
3334 ,FdOption(..)
3435 )
3536
36−import Foreign ( malloc, poke, peek, free )
37+import Foreign ( alloca, poke, peek, Ptr )
3738
3839-- |Representations of non-modifier keys.
3940data Key = KEsc | KFun Int | KBackTab | KPrtScr | KPause | KASCII Char | KBS | KIns
@@ -76,32 +77,34 @@ initTermInput escDelay terminal = do
7677 where loop kb = case (classify kb) of
7778 Prefix -> do c <- readChan inputChannel
7879 loop (kb ++ [c])
79− Invalid -> loop ""
80+ Invalid -> do c <- readChan inputChannel
81+ loop [c]
8082 MisPfx k m s -> writeChan eventChannel (EvKey k m) >> loop s
8183 Valid k m -> writeChan eventChannel (EvKey k m) >> loop ""
8284
8385 finishAtomicInput = writeChan inputChannel '\xFFFE'
8486
8587 inputThread :: IO ()
86− inputThread = loop
87− where
88− loop = do
89− setFdOption stdInput NonBlockingRead False
90− threadWaitRead stdInput
91− setFdOption stdInput NonBlockingRead True
92− _ <- try readAll :: IO (Either IOException ())
93− when (escDelay == 0) finishAtomicInput
94− loop
95− readAll = do
96− ptr <- malloc
97− poke ptr 0
98− bytes_read <- fdReadBuf stdInput ptr 1
99− bytes <- fmap ((: "") . chr . fromIntegral) $ peek ptr
100− free ptr
101− when (bytes_read > 0) $ do
102− _ <- tryPutMVar hadInput () -- signal input
103− writeChan inputChannel (head bytes)
104− readAll
88+ inputThread = do
89+ _ <- alloca $ \(input_buffer :: Ptr Word8) -> do
90+ let loop = do
91+ setFdOption stdInput NonBlockingRead False
92+ threadWaitRead stdInput
93+ setFdOption stdInput NonBlockingRead True
94+ _ <- try readAll :: IO (Either IOException ())
95+ when (escDelay == 0) finishAtomicInput
96+ loop
97+ readAll = do
98+ poke input_buffer 0
99+ bytes_read <- fdReadBuf stdInput input_buffer 1
100+ input_char <- fmap (chr . fromIntegral) $ peek input_buffer
101+ when (bytes_read > 0) $ do
102+ _ <- tryPutMVar hadInput () -- signal input
103+ writeChan inputChannel input_char
104+ readAll
105+ loop
106+ return ()
107+
105108 -- | If there is no input for some time, this thread puts '\xFFFE' in the
106109 -- inputChannel.
107110 noInputThread :: IO ()
@@ -110,6 +113,7 @@ initTermInput escDelay terminal = do
110113 takeMVar hadInput -- wait for some input
111114 threadDelay escDelay -- microseconds
112115 hadNoInput <- isEmptyMVar hadInput -- no input yet?
116+ -- TODO(corey): there is a race between here and the inputThread.
113117 when hadNoInput $ do
114118 finishAtomicInput
115119 loop
@@ -224,6 +228,7 @@ initTermInput escDelay terminal = do
224228 writeChan eventChannel (EvResize e e))
225229 _ <- installHandler windowChange pokeIO Nothing
226230 _ <- installHandler continueProcess pokeIO Nothing
231+ -- TODO(corey): killThread is a bit risky for my tastes.
227232 let uninit = do killThread eventThreadId
228233 killThread inputThreadId
229234 killThread noInputThreadId