diff options
author | Kierán Meinhardt <kieran.meinhardt@gmail.com> | 2020-09-23 17:44:40 +0200 |
---|---|---|
committer | Kierán Meinhardt <kieran.meinhardt@gmail.com> | 2020-09-23 17:44:40 +0200 |
commit | 8e92e6e11d2b3b0bfb5ac9d68f347219493e6380 (patch) | |
tree | 6484ca42d85ca89475e922f7b45039c116ebbf97 /src/Much/Screen.hs | |
parent | 6a6ad3aecd53ffd89101a0dee2b4ea576d4964d4 (diff) |
split into library + executables
Diffstat (limited to 'src/Much/Screen.hs')
-rw-r--r-- | src/Much/Screen.hs | 32 |
1 files changed, 32 insertions, 0 deletions
diff --git a/src/Much/Screen.hs b/src/Much/Screen.hs new file mode 100644 index 0000000..47bb90c --- /dev/null +++ b/src/Much/Screen.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE RecordWildCards #-} +module Much.Screen (Screen(..), setScreen, withScreen) where + +import Control.Exception +import Data.List +import System.IO + +data Screen = Screen + { stdinEcho :: Bool + , stdinBufferMode :: BufferMode + , stdoutBufferMode :: BufferMode + , decsetPm :: [Int] + , decrstPm :: [Int] + } + +setScreen :: Screen -> IO Screen +setScreen Screen{..} = get <* set where + get = Screen <$> hGetEcho stdin + <*> hGetBuffering stdin + <*> hGetBuffering stdout + <*> pure decrstPm + <*> pure decsetPm + set = do + hSetEcho stdin stdinEcho + hSetBuffering stdin stdinBufferMode + hSetBuffering stdout stdoutBufferMode + hPutStr stdout $ "\ESC[?" ++ intercalate ";" (map show decsetPm) ++ "h" + hPutStr stdout $ "\ESC[?" ++ intercalate ";" (map show decrstPm) ++ "l" + hFlush stdout + +withScreen :: Screen -> (Screen -> IO a) -> IO a +withScreen s = bracket (setScreen s) setScreen |