diff options
Diffstat (limited to 'Main.hs')
| -rw-r--r-- | Main.hs | 46 |
1 files changed, 37 insertions, 9 deletions
@@ -21,14 +21,16 @@ import Control.Monad.State import Control.Monad.Writer import Buffer +import Process data VTConfig = VTConfig - { + { withOutput :: IO () -> IO () } data VTState = VTState { buffer :: Buffer , mode :: Mode + , processCount :: Int } main :: IO () @@ -43,7 +45,8 @@ main = do let st = VTState { mode = InsertMode - , buffer = ("Was geht ab, Junge?", " ^_^") + , buffer = ("", "") + , processCount = 0 } lockRef <- newMVar () @@ -58,12 +61,16 @@ main = do renderInputLine (mode q) (buffer q) hFlush stdout + let cf = VTConfig + { withOutput = withOutput + } + -- render initial input line withOutput $ return () forkIO $ dateThread withOutput 1000000 - uiThread withOutput putState getState + uiThread cf putState getState dateThread :: (IO () -> IO ()) -> Int -> IO () @@ -74,11 +81,11 @@ dateThread withOutput delay = forever $ do threadDelay delay -uiThread :: (IO () -> IO ()) -> (VTState -> IO ()) -> IO VTState -> IO () -uiThread withOutput putState getState = forever $ do +uiThread :: VTConfig -> (VTState -> IO ()) -> IO VTState -> IO () +uiThread cf putState getState = forever $ do q0 <- getState - ((eitCmd, lines), q1) <- runVT VTConfig q0 $ do + ((eitCmd, lines), q1) <- runVT cf q0 $ do c <- getCommand (mode q0) execCommand c return c @@ -96,7 +103,7 @@ uiThread withOutput putState getState = forever $ do _ -> Nothing - withOutput $ do + withOutput cf $ do forM_ lines putStrLn case mbErr of @@ -213,8 +220,29 @@ execCommand (InsertString s) = modifyBuffer (insertString s) execCommand ExecuteInputBuffer = do - b <- gets buffer - tell [ "input: <" ++ (concat $ map (reform 32) $ showBuffer b) ++ ">" ] + + ---- XXX hack to replace empty command line + --gets (null . showBuffer . buffer) >>= flip when + -- (modify $ \q -> q { buffer = ("!","") }) + + st <- get + + case showBuffer (buffer st) of + '!' : cmdline -> do + --tell [ "spawn: " ++ cmdline ] + -- "input: <" ++ (concat $ map (reform 32) $ showBuffer b) ++ ">" ] + -- TODO register process + i <- state $ \ q -> + let i = processCount q + 1 + in (i, q { processCount = i }) + cf <- ask + liftIO $ forkIO $ spawn i (withOutput cf) cmdline + return () + "" -> do + liftIO ringBell + s -> do + tell [ "input: <" ++ (concat $ map (reform 32) s) ++ ">" ] + modifyBuffer (const emptyBuffer) execCommand KillNextChar = do |