From 92582dcaf3c8b48f5438c659bf90f71d5da0c9e2 Mon Sep 17 00:00:00 2001
From: Benjamin Barenblat <bbaren@mit.edu>
Date: Wed, 27 May 2015 22:36:02 -0500
Subject: Support (nonfunctional) basic command input
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Allow typing stuff into the prompt.  You can’t backspace, and nothing
happens when you hit Enter.  Also, there’s no cursor.  But input does
work, and it’s responsive.
---
 src/Main.hs | 38 ++++++++++++++++++++++++++++----------
 1 file changed, 28 insertions(+), 10 deletions(-)

diff --git a/src/Main.hs b/src/Main.hs
index e3b8448..8bd2729 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -17,6 +17,7 @@ module Main (main) where
 import Prelude hiding (lines, log)
 
 import Control.Concurrent (forkIO, threadDelay)
+import Control.Concurrent.Chan
 import Control.Monad (forever, void)
 import Data.Default.Class (def)
 import Data.IORef
@@ -40,20 +41,37 @@ jarvis :: Vty -> IO ()
 jarvis terminal = do
   log <- newIORef Vty.emptyImage
   prompt <- newIORef Vty.emptyImage
+  promptInput <- newChan
   ready <- Flag.new
   void $ forkIO $ redrawer ready log prompt terminal
-  void $ forkIO $ prompter prompt ready
+  void $ forkIO $ prompter promptInput prompt ready
   void $ forkIO $ logger log ready
-  void $ Vty.nextEvent terminal
+  processEvents terminal promptInput
 
-prompter :: IORef Vty.Image -> Flag -> IO ()
-prompter output redraw = prompt' 0
-  where prompt' :: Integer -> IO ()
-        prompt' n = do
-          writeIORef output $ Vty.string def ("jarvis " ++ show n ++ " >")
-          Flag.wave redraw
-          threadDelay 1000000
-          prompt' (n + 1)
+processEvents :: Vty -> Chan Vty.Event -> IO ()
+processEvents terminal promptInput = do
+  event <- Vty.nextEvent terminal
+  case event of
+    Vty.EvKey (Vty.KChar 'd') [Vty.MCtrl] -> return ()
+    Vty.EvKey (Vty.KChar _) _ -> writeChan promptInput event >> continue
+    _ -> continue
+  where continue = processEvents terminal promptInput
+
+prompter :: Chan Vty.Event -> IORef Vty.Image -> Flag -> IO ()
+prompter input output redraw = do
+  let promptString = "> "
+  writeIORef output $ Vty.string def promptString
+  Flag.wave redraw
+  readCommand ""
+  where readCommand command = do
+          event <- readChan input
+          case event of
+            Vty.EvKey (Vty.KChar c) _ -> do
+              let command' = command ++ [c]
+              writeIORef output $ Vty.string def $ "> " ++ command'
+              Flag.wave redraw
+              readCommand command'
+            _ -> readCommand command
 
 logger :: IORef Vty.Image -> Flag -> IO ()
 logger output redraw = log 0 []
-- 
cgit v1.2.3