diff options
Diffstat (limited to 'src/Terminal.hs')
-rw-r--r-- | src/Terminal.hs | 79 |
1 files changed, 79 insertions, 0 deletions
diff --git a/src/Terminal.hs b/src/Terminal.hs new file mode 100644 index 0000000..aa7335c --- /dev/null +++ b/src/Terminal.hs @@ -0,0 +1,79 @@ +module Terminal ( + TerminalOutput, + TerminalLine, + TerminalFootnote(..), + initTerminalOutput, + newLine, + redrawLine, + newFootnote, + terminalBlinkStatus, +) where + +import Control.Concurrent +import Control.Concurrent.STM +import Control.Monad + +import Data.Function +import Data.Text (Text) +import Data.Text qualified as T +import Data.Text.IO qualified as T + +import System.IO + + +data TerminalOutput = TerminalOutput + { outNumLines :: MVar Int + , outNextFootnote :: MVar Int + , outBlinkVar :: TVar Bool + } + +instance Eq TerminalOutput where + (==) = (==) `on` outNumLines + +data TerminalLine = TerminalLine + { lineOutput :: TerminalOutput + , lineNum :: Int + } + deriving (Eq) + +data TerminalFootnote = TerminalFootnote + { footnoteLine :: TerminalLine + , footnoteNumber :: Int + , footnoteText :: Text + } + deriving (Eq) + +initTerminalOutput :: IO TerminalOutput +initTerminalOutput = do + outNumLines <- newMVar 0 + outNextFootnote <- newMVar 1 + outBlinkVar <- newTVarIO False + void $ forkIO $ forever $ do + threadDelay 500000 + atomically $ writeTVar outBlinkVar . not =<< readTVar outBlinkVar + return TerminalOutput {..} + +newLine :: TerminalOutput -> Text -> IO TerminalLine +newLine lineOutput@TerminalOutput {..} text = do + modifyMVar outNumLines $ \lineNum -> do + T.putStrLn text + hFlush stdout + return ( lineNum + 1, TerminalLine {..} ) + +redrawLine :: TerminalLine -> Text -> IO () +redrawLine TerminalLine {..} text = do + let TerminalOutput {..} = lineOutput + withMVar outNumLines $ \total -> do + let moveBy = total - lineNum + T.putStr $ "\ESC[s\ESC[" <> T.pack (show moveBy) <> "F" <> text <> "\ESC[u" + hFlush stdout + +newFootnote :: TerminalOutput -> Text -> IO TerminalFootnote +newFootnote tout@TerminalOutput {..} footnoteText = do + modifyMVar outNextFootnote $ \footnoteNumber -> do + footnoteLine <- newLine tout $ "[" <> T.pack (show footnoteNumber) <> "] " <> footnoteText + hFlush stdout + return ( footnoteNumber + 1, TerminalFootnote {..} ) + +terminalBlinkStatus :: TerminalOutput -> STM Bool +terminalBlinkStatus TerminalOutput {..} = readTVar outBlinkVar |