start refactoring input layer into a nice interface structure

cbits/set_term_timing.c

@@ -11,4 +11,3 @@ void vty_set_term_timing(void)
     trm.c_cc[VTIME] = 0;
     tcsetattr(STDIN_FILENO, TCSANOW, &trm); 
 }
-

src/Graphics/Vty.hs

@@ -41,6 +41,8 @@ import Graphics.Vty.Input
 import Graphics.Vty.Output
 import Graphics.Vty.Picture
 
+import Control.Concurrent
+
 import Data.IORef
 
 import qualified System.Console.Terminfo as Terminfo
@@ -69,7 +71,9 @@ data Vty = Vty
       update :: Picture -> IO ()
       -- | Get one Event object, blocking if necessary.
     , next_event :: IO Event
-      -- | The output interface. See `Output`
+      -- | The input interface. See 'Input'
+    , input_iface :: Input
+      -- | The output interface. See 'Output'
     , output_iface :: Output
       -- | Refresh the display. Normally the library takes care of refreshing.  Nonetheless, some
       -- other program might output to the terminal and mess the display.  In that case the user
@@ -91,14 +95,17 @@ mkVty = mkVtyEscDelay defaultEscDelay
 -- \todo move input init into terminal interface
 mkVtyEscDelay :: Int -> IO Vty
 mkVtyEscDelay escDelay = do
-    term_info <- Terminfo.setupTermFromEnv
-    t <- output_for_current_terminal
-    reserve_display t
-    (kvar, endi) <- initTermInput escDelay term_info
-    intMkVty kvar ( endi >> release_display t >> release_terminal t ) t
+    input <- input_for_current_terminal escDelay
+    out <- output_for_current_terminal
+    reserve_display out
+    intMkVty input out
 
-intMkVty :: IO Event -> IO () -> Output -> IO Vty
-intMkVty kvar fend out = do
+intMkVty :: Input -> Output -> IO Vty
+intMkVty input out = do
+    let shutdown_io = do
+            shutdown_input input
+            release_display out
+            release_terminal out
     last_pic_ref <- newIORef Nothing
     last_update_ref <- newIORef Nothing
 
@@ -141,7 +148,7 @@ intMkVty kvar fend out = do
             >>  readIORef last_pic_ref 
             >>= maybe ( return () ) ( \pic -> inner_update pic ) 
 
-    let gkey = do k <- kvar
+    let gkey = do k <- readChan $ event_channel input
                   case k of 
                     (EvResize _ _)  -> inner_refresh
                                        >> display_bounds out
@@ -150,8 +157,9 @@ intMkVty kvar fend out = do
 
     return $ Vty { update = inner_update
                  , next_event = gkey
+                 , input_iface = input
                  , output_iface = out
                  , refresh = inner_refresh
-                 , shutdown = fend 
+                 , shutdown = shutdown_io
                  }
 

src/Graphics/Vty/Input.hs

@@ -4,8 +4,10 @@ module Graphics.Vty.Input ( Key(..)
                           , Modifier(..)
                           , Button(..)
                           , Event(..)
-                          , initTermInput
+                          , Input(..)
                           , defaultEscDelay
+                          , input_for_current_terminal
+                          , input_for_name_and_io
                           )
     where
 
@@ -15,11 +17,12 @@ import Graphics.Vty.Input.Terminfo
 
 import Control.Concurrent
 
-import System.Console.Terminfo
-
+import qualified System.Console.Terminfo as Terminfo
+import System.Environment
 import System.Posix.Signals.Exts
 import System.Posix.Terminal
 import System.Posix.IO (stdInput)
+import System.Posix.Types (Fd)
 
 -- Right, I'm mostly guessing on these details. So, as far as I can figure:
 --
@@ -45,6 +48,13 @@ import System.Posix.IO (stdInput)
 defaultEscDelay :: Int
 defaultEscDelay = 10000
 
+-- | Set up the current terminal for input.
+-- This determines the current terminal then invokes 'input_for_name_and_io'
+input_for_current_terminal :: Int -> IO Input
+input_for_current_terminal escDelay = do
+    term_name <- getEnv "TERM"
+    input_for_name_and_io escDelay term_name stdInput
+
 -- | Set up the terminal for input.  Returns a function which reads key
 -- events, and a function for shutting down the terminal access.
 --
@@ -71,26 +81,29 @@ defaultEscDelay = 10000
 -- * IEXTEN disabled
 --      - extended functions are disabled. Uh. Whatever these are.
 --
-initTermInput :: Int -> Terminal -> IO (IO Event, IO ())
-initTermInput escDelay terminal = do
-    attr <- getTerminalAttributes stdInput
+input_for_name_and_io :: Int -> String -> Fd -> IO Input
+input_for_name_and_io escDelay term_name term_in = do
+    terminal <- Terminfo.setupTerm term_name
+    attr <- getTerminalAttributes term_in
     let attr' = foldl withoutMode attr [ StartStopOutput, KeyboardInterrupts
                                        , EnableEcho, ProcessInput, ExtendedFunctions
                                        ]
-    setTerminalAttributes stdInput attr' Immediately
+    setTerminalAttributes term_in attr' Immediately
+    -- TODO: pass Fd to set_term_timing
     set_term_timing
     let classify_table = classify_table_for_term terminal
-    (eventChannel, shutdown_input) <- initInputForFd escDelay classify_table stdInput
+    (eventChannel, shutdown_event_processing) <- initInputForFd escDelay classify_table term_in
     let pokeIO = Catch $ do
             let e = error "(getsize in input layer)"
-            setTerminalAttributes stdInput attr' Immediately
+            setTerminalAttributes term_in attr' Immediately
             writeChan eventChannel (EvResize e e)
     _ <- installHandler windowChange pokeIO Nothing
     _ <- installHandler continueProcess pokeIO Nothing
-    let shutdown_input' = do
-            shutdown_input
+    return $ Input
+        { event_channel  = eventChannel
+        , shutdown_input = do
+            shutdown_event_processing
             _ <- installHandler windowChange Ignore Nothing
             _ <- installHandler continueProcess Ignore Nothing
-            setTerminalAttributes stdInput attr Immediately
-    return (readChan eventChannel, shutdown_input')
-
+            setTerminalAttributes term_in attr Immediately
+        }

src/Graphics/Vty/Input/Internal.hs

@@ -22,6 +22,11 @@ import System.Posix.IO ( fdReadBuf
                        )
 import System.Posix.Types (Fd(..))
 
+data Input = Input
+    { event_channel  :: Chan Event
+    , shutdown_input :: IO ()
+    }
+
 data KClass
     = Valid Key [Modifier]
     | Invalid
@@ -141,11 +146,11 @@ initInputForFd escDelay classify_table input_fd = do
     noInputThreadId <- forkIO $ noInputThread
     -- TODO(corey): killThread is a bit risky for my tastes.
     -- H - somewhat mitigated by sending a magic terminate character?
-    let shutdown_input = do
+    let shutdown_event_processing = do
             writeChan inputChannel '\xFFFD' 
             killThread noInputThreadId
             killThread eventThreadId
             killThread inputThreadId
-    return (eventChannel, shutdown_input)
+    return (eventChannel, shutdown_event_processing)
 
 foreign import ccall "vty_set_term_timing" set_term_timing :: IO ()

test/VerifyUsingMockInput.hs

@@ -107,12 +107,12 @@ assert_events_from_syn_input table input_spec expected_events = do
     let max_duration = sum [t | Delay t <- input_spec] + min_detectable_delay
         event_count = length expected_events
     (output_fd, input_fd) <- createPipe
-    (output, shutdown_input) <- initInputForFd test_esc_sample_delay table output_fd
+    (output, shutdown_event_processing) <- initInputForFd test_esc_sample_delay table output_fd
     events_ref <- newIORef []
     let write_wait_close = do
             synthesize_input input_spec input_fd
             threadDelay min_detectable_delay
-            shutdown_input
+            shutdown_event_processing
             threadDelay min_detectable_delay
             closeFd input_fd
             closeFd output_fd