diff options
| -rw-r--r-- | Main.hs | 44 |
1 files changed, 29 insertions, 15 deletions
@@ -70,9 +70,23 @@ dateThread delay modeRef lock = forever $ do threadDelay delay +uiThread :: IORef Mode -> MVar Buffer -> IO () uiThread modeRef lock = do m <- readIORef modeRef - c <- getCommand m + b <- readMVar lock + let cf = VTConfig + { + } + st = VTState + { mode = m + , buffer = b + } + ((eCmd, _), _) <- runVT cf st (getCommand m) + + let c = case eCmd of + Left _ -> undefined + Right cmd -> cmd + m' <- modifyMVar lock $ \ buf -> do let cf = VTConfig { @@ -393,33 +407,33 @@ instance Show Mode where show VerbatimMode = "verbatim" -getCommand :: Mode -> IO Command +getCommand :: Mode -> VT Command getCommand InsertMode = getCommandXXX imap InsertString getCommand NormalMode = getCommandXXX nmap AlertBadInput getCommand VerbatimMode = verbatimKeymap -- TODO refactor me please^_^ -getCommandXXX :: Keymap -> (String -> Command) -> IO Command +getCommandXXX :: Keymap -> (String -> Command) -> VT Command getCommandXXX keymap defCmd = do -- wait for the first character - c <- hLookAhead stdin + c <- liftIO $ hLookAhead stdin - bufRef <- newIORef "" - candRef <- newIORef Nothing - cmdRef <- newEmptyMVar -- :: MVar (Maybe (String -> Command)) + bufRef <- liftIO $ newIORef "" + candRef <- liftIO $ newIORef Nothing + cmdRef <- liftIO $ newEmptyMVar -- :: MVar (Maybe (String -> Command)) -- TODO ensure that this thread dies eventually --forkIO $ rec "" keymap cmdRef candRef getCharThreadId <- --forkFinally (rec keymap cmdRef candRef bufRef) -- (\_ -> putStrLn "input terminated") - forkIO $ do + liftIO $ forkIO $ do rec keymap cmdRef candRef bufRef watchDogThreadId <- - forkIO $ do + liftIO $ forkIO $ do --putStrLn "watchdog activated" threadDelay $ 1000 * 50 -- 50ms --putStrLn "watchdog timeout" @@ -427,19 +441,19 @@ getCommandXXX keymap defCmd = do --putStrLn "watchdog killed getCharThread" putMVar cmdRef Nothing -- continue main thread - mbCmd <- takeMVar cmdRef + mbCmd <- liftIO $ takeMVar cmdRef - killThread watchDogThreadId + liftIO $ killThread watchDogThreadId cmd <- case mbCmd of Just cmd -> return cmd Nothing -> do - mbCmd2 <- readIORef candRef + mbCmd2 <- liftIO $ readIORef candRef case mbCmd2 of Just cmd2 -> return cmd2 Nothing -> return defCmd - s <- readIORef bufRef + s <- liftIO $ readIORef bufRef --clearLine --putStrLn $ "\x1b[35;1m" ++ (show s) ++ " -> " ++ (show $ cmd s) ++ "\x1b[m" @@ -495,9 +509,9 @@ getCommandXXX keymap defCmd = do -verbatimKeymap :: IO Command +verbatimKeymap :: VT Command verbatimKeymap = do - c <- getChar + c <- liftIO getChar return $ InsertString [c] <> ChangeMode InsertMode |