diff options
| -rw-r--r-- | Main.hs | 47 |
1 files changed, 33 insertions, 14 deletions
@@ -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) "" |