module Graphics.Vty.Output ( initTermOutput
, clrscr
, getwinsize
, beep
, flush
, tputchar
, chgatt
, putShow
)
where
import Graphics.Vty.Types
import Graphics.Vty.ControlStrings
import Control.Monad ( when )
import Data.Bits ( (.|.), (.&.), shiftR )
import Foreign.C.Types ( CLong )
import System.Console.Terminfo
import System.IO ( stdout, hFlush )
initTermOutput :: Terminal -> IO (TermState, IO ())
initTermOutput terminal = do
let cap_smcup = getCapability terminal $ tiGetStr "smcup"
maybe (return ()) putStr cap_smcup
putStr reset
hFlush stdout
return (TS 0 0 attr, uninitTermOutput terminal)
uninitTermOutput :: Terminal -> IO ()
uninitTermOutput terminal = do
(_,sy) <- getwinsize_
putStr (endterm sy)
let cap_rmcup = getCapability terminal $ tiGetStr "rmcup"
maybe (return ()) putStr cap_rmcup
hFlush stdout
flush :: TermState -> IO TermState
flush ts = hFlush stdout >> return ts
clrscr :: TermState -> IO TermState
clrscr _ts = do putStr reset
return (TS 0 0 attr)
chgatt :: Attr -> IO ()
chgatt (Attr bf)
= putStr "\ESC[0;" >>
putShow (bf .&. 0xFF) >>
putStr ";" >> putShow ((bf `shiftR` 8) .&. 0xFF) >>
0x10000 ? ";1" >>
0x20000 ? ";5" >> 0x40000 ? ";7" >> 0x80000 ? ";2" >> 0x100000 ? ";4" >>
putStr "m"
where
(?) :: Int -> [Char] -> IO ()
field ? x | bf .&. field == 0 = return ()
| otherwise = putStr x
tputchar :: Char -> IO ()
tputchar ch | ich < 0x80 = pch ich
| ich < 0x800 = pch (0xC0 .|. (ich `usr` 6)) >> pch (0x80 .|. (0x3F .&. ich))
| ich < 0x10000 = pch (0xE0 .|. (ich `usr` 12)) >> pch (0x80 .|. (0x3F .&. (ich `usr` 6))) >>
pch (0x80 .|. (0x3F .&. ich))
| otherwise = pch (0xF0 .|. (ich `usr` 24)) >> pch (0x80 .|. (0x3F .&. (ich `usr` 12))) >>
pch (0x80 .|. (0x3F .&. (ich `usr` 6))) >> pch (0x80 .|. (0x3F .&. ich))
where ich = fromEnum ch
pch = putChar . toEnum
usr = shiftR
putShow :: Int -> IO ()
putShow n = when (ini /= 0) (putShow ini) >> putChar (toEnum (lst + 48))
where (ini, lst) = divMod n 10
foreign import ccall "gwinsz.h c_get_window_size" c_get_window_size :: IO CLong
getwinsize_ :: IO (Int,Int)
getwinsize_ = do (a,b) <- (`divMod` 65536) `fmap` c_get_window_size
return (fromIntegral b, fromIntegral a)
getwinsize :: TermState -> IO ((Int,Int), TermState)
getwinsize ts = do (a,b) <- (`divMod` 65536) `fmap` c_get_window_size
return ((fromIntegral b, fromIntegral a), ts)
reset :: String
reset =
utf8CharSet ++
setCursorPosition 1 1 ++
"\ESC[2J"
beep :: IO ()
beep = putStr "\BEL"
endterm :: Int -> [Char]
endterm sy = setCursorPosition sy 1 ++
"\ESC[0;39;49m" ++
defaultCharSet ++
"\CR" ++
cvis ++
"\ESC[K"
defaultCharSet, utf8CharSet :: String
defaultCharSet = "\ESC%@"
utf8CharSet = "\ESC%G"