mirror of
https://github.com/ilyakooo0/vty.git
synced 2024-10-04 11:17:08 +03:00
start refactoring input layer into a nice interface structure
This commit is contained in:
parent
e994b3b5dc
commit
b3013245fd
@ -11,4 +11,3 @@ void vty_set_term_timing(void)
|
||||
trm.c_cc[VTIME] = 0;
|
||||
tcsetattr(STDIN_FILENO, TCSANOW, &trm);
|
||||
}
|
||||
|
||||
|
@ -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
|
||||
}
|
||||
|
||||
|
@ -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
|
||||
}
|
||||
|
@ -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 ()
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user