render mode on the right side of the input line

1 files changed, 33 insertions, 14 deletions

diff --git a/Main.hs b/Main.hs
index 7028998..8e75119 100644
--- a/Main.hs
+++ b/Main.hs
@@ -41,30 +41,34 @@ main = do
   -- WINCH
   -- TODO installHandler 28 (Catch $ ioctl 0 ...) Nothing
 
+  modeRef <- newIORef InsertMode
   lock <- newMVar emptyBuffer
 
-  renderInputLine emptyBuffer
+  renderInputLine InsertMode emptyBuffer
   hFlush stdout
 
-  forkIO $ (dateThread 1000000) lock
-  uiThread InsertMode lock
+  forkIO $ dateThread 1000000 modeRef lock
+  uiThread modeRef lock
 
 
-dateThread delay lock = forever $ do
+dateThread :: Int -> IORef Mode -> MVar Buffer -> IO ()
+dateThread delay modeRef lock = forever $ do
     t <- getCurrentTime
+    m <- readIORef modeRef
     withMVar lock $ \ buf -> do
       clearLine
       putStrLn $ formatTime defaultTimeLocale rfc822DateFormat t
-      renderInputLine buf
+      renderInputLine m buf
       hFlush stdout
     threadDelay delay
 
 
-uiThread mod lock = do
-    c <- getCommand mod
-    mod' <- modifyMVar lock $ \ buf -> do
+uiThread modeRef lock = do
+    m <- readIORef modeRef
+    c <- getCommand m
+    m' <- modifyMVar lock $ \ buf -> do
         let st = VTState
-                { mode = mod
+                { mode = m
                 , buffer = buf
                 }
 
@@ -89,11 +93,12 @@ uiThread mod lock = do
         when (show (mode st) /= show (mode st')) $ do
             putStrLn $ "change mode: " ++ (show $ mode st')
 
-        renderInputLine (buffer st')
+        renderInputLine (mode st') (buffer st')
         hFlush stdout
         return (buffer st', mode st')
 
-    uiThread mod' lock
+    writeIORef modeRef m'
+    uiThread modeRef lock
 
 
 data Command
@@ -247,8 +252,14 @@ special colorCode s = "\x1b[1;" ++ show colorCode ++ "m" ++ s ++ "\x1b[m"
 
 
 -- XXX assumes that the cursor is already at the (cleared) input line
-renderInputLine :: Buffer -> IO ()
-renderInputLine (lhs, rhs) = do
+renderInputLine :: Mode -> Buffer -> IO ()
+renderInputLine m (lhs, rhs) = do
+    clearLine -- TODO this is required for drawing the mode on the right side
+    saveCursor
+    moveCursorRight 1024
+    moveCursorLeft (length (show m) - 1)
+    putStr $ "\x1b[1;30m" ++ show m ++ "\x1b[m"
+    unsaveCursor
     putStr $ "> " ++ pp lhs ++ pp rhs
     moveCursorLeft (length $ ppVis rhs)
   where
@@ -279,16 +290,24 @@ renderInputLine (lhs, rhs) = do
 
 clearLine =
     putStr "\x1b[2K" >>
-    moveCursorLeft 80
+    moveCursorLeft 1024
 
 
 ringBell = putStr "\x07" -- BEL '\a'
 
 
+saveCursor = putStr "\x1b[s"
+unsaveCursor = putStr "\x1b[u"
+
+
 moveCursorLeft 0 = return ()
 moveCursorLeft i = putStr $ "\x1b[" ++ show i ++ "D"
 
 
+moveCursorRight 0 = return ()
+moveCursorRight i = putStr $ "\x1b[" ++ show i ++ "C"
+
+
 -- TODO? charToCode c = "\\x" ++ showHex (ord c)
 charToCode c = "\\x" ++ showIntAtBase 16 intToDigit (ord c) ""