From cb460f6382e237c95c4201c31e409118d93e1235 Mon Sep 17 00:00:00 2001
From: tv <tv@shackspace.de>
Date: Mon, 28 Jul 2014 14:01:01 +0200
Subject: Process: initial commit

---
 Main.hs | 46 +++++++++++++++++++++++++++++++++++++---------
 1 file changed, 37 insertions(+), 9 deletions(-)

(limited to 'Main.hs')

diff --git a/Main.hs b/Main.hs
index adb022d..36d066d 100644
--- a/Main.hs
+++ b/Main.hs
@@ -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
-- 
cgit v1.2.3