module FRP.Timeless.Framework.Console
where
import Prelude hiding ((.), id)
import FRP.Timeless
import System.IO
import System.Console.ANSI
import Control.Monad
data InitConfig = InitConfig
{
initInHandle :: Handle
, initOutHandle :: Handle
, initEcho :: Bool
, initInBuffering :: BufferMode
, initOutBuffering :: BufferMode
, initShowCursor :: Bool
}
defaultInitConfig = InitConfig stdin stdout False NoBuffering NoBuffering False
initConsole :: InitConfig -> IO ()
initConsole conf = do
let hIn = initInHandle conf
hOut = initOutHandle conf
clearScreen
hSetEcho hIn False
hSetBuffering hIn $ initInBuffering conf
hSetBuffering hOut $ initOutBuffering conf
if initShowCursor conf then
hShowCursor hOut else
hHideCursor hOut
asciiBox :: Int -> Int -> ColorIntensity -> Color -> IO ()
asciiBox w h i c = do
let tbLine = "+" ++ (replicate (w2) '-') ++ "+"
setCursorPosition 0 0
setSGR [SetColor Foreground i c]
putStrLn tbLine
mapM_ (\rol -> drawChar '|' rol 0 i c >> drawChar '|' rol (w1) i c) [1..h2]
setSGR [SetColor Foreground i c]
setCursorPosition (h1) 0
putStrLn tbLine
setSGR [Reset]
drawChar :: Char -> Int -> Int -> ColorIntensity -> Color -> IO ()
drawChar c rol col i color = do
setCursorPosition rol col
setSGR [SetColor Foreground i color]
putChar c
setSGR [Reset]
drawCharS :: Char
-> ColorIntensity -> Color
-> (Int, Int)
-> (Int, Int)
-> IO (Int, Int)
drawCharS c i col (r0,c0) (r',c')
| (r0,c0) /= (r',c') =
do
drawChar ' ' r0 c0 i col
drawChar c r' c' i col
return (r', c')
| otherwise = return (r0, c0)
clearLineRange :: Int
-> Int
-> Int
-> IO ()
clearLineRange r c c' = do
setCursorPosition r c
let l = c' c
cover = replicate l ' '
putStr cover
sInputNonBlocking :: Signal s IO () (Maybe Char)
sInputNonBlocking = mkActM f
where
f :: IO (Maybe Char)
f = do
b <- hReady stdin
case b of
True -> Just <$> getChar
False -> return Nothing