summaryrefslogtreecommitdiffstats
path: root/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Main.hs')
-rw-r--r--Main.hs47
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) ""