module System.Terminal.Virtual where

import           Control.Monad.STM
import           Control.Concurrent.STM.TVar
import           Control.Monad.IO.Class
import qualified Data.ByteString   as BS
import qualified Data.Text         as T

import           System.Terminal.MonadInput
import           System.Terminal.MonadScreen (Size (..), Position (..), EraseMode (..))
import           System.Terminal.Terminal

data VirtualTerminal
    = VirtualTerminal
    { VirtualTerminal -> VirtualTerminalSettings
virtualSettings              :: VirtualTerminalSettings
    , VirtualTerminal -> TVar Position
virtualCursor                :: TVar Position
    , VirtualTerminal -> TVar [String]
virtualWindow                :: TVar [String]
    , VirtualTerminal -> TVar Bool
virtualAutoWrap              :: TVar Bool
    , VirtualTerminal -> TVar Bool
virtualAlternateScreenBuffer :: TVar Bool
    }

data VirtualTerminalSettings
    = VirtualTerminalSettings
    { VirtualTerminalSettings -> ByteString
virtualType              :: BS.ByteString
    , VirtualTerminalSettings -> STM Size
virtualWindowSize        :: STM Size
    , VirtualTerminalSettings -> STM Event
virtualEvent             :: STM Event
    , VirtualTerminalSettings -> STM Interrupt
virtualInterrupt         :: STM Interrupt
    }

instance Terminal VirtualTerminal where
    termType :: VirtualTerminal -> ByteString
termType              = VirtualTerminalSettings -> ByteString
virtualType      (VirtualTerminalSettings -> ByteString)
-> (VirtualTerminal -> VirtualTerminalSettings)
-> VirtualTerminal
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VirtualTerminal -> VirtualTerminalSettings
virtualSettings
    termEvent :: VirtualTerminal -> STM Event
termEvent             = VirtualTerminalSettings -> STM Event
virtualEvent     (VirtualTerminalSettings -> STM Event)
-> (VirtualTerminal -> VirtualTerminalSettings)
-> VirtualTerminal
-> STM Event
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VirtualTerminal -> VirtualTerminalSettings
virtualSettings
    termInterrupt :: VirtualTerminal -> STM Interrupt
termInterrupt         = VirtualTerminalSettings -> STM Interrupt
virtualInterrupt (VirtualTerminalSettings -> STM Interrupt)
-> (VirtualTerminal -> VirtualTerminalSettings)
-> VirtualTerminal
-> STM Interrupt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VirtualTerminal -> VirtualTerminalSettings
virtualSettings
    termCommand :: VirtualTerminal -> Command -> IO ()
termCommand VirtualTerminal
t Command
c       = STM () -> IO ()
forall a. STM a -> IO a
atomically (VirtualTerminal -> Command -> STM ()
command VirtualTerminal
t Command
c)
    termFlush :: VirtualTerminal -> IO ()
termFlush VirtualTerminal
_           = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    termGetWindowSize :: VirtualTerminal -> IO Size
termGetWindowSize     = STM Size -> IO Size
forall a. STM a -> IO a
atomically (STM Size -> IO Size)
-> (VirtualTerminal -> STM Size) -> VirtualTerminal -> IO Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VirtualTerminalSettings -> STM Size
virtualWindowSize (VirtualTerminalSettings -> STM Size)
-> (VirtualTerminal -> VirtualTerminalSettings)
-> VirtualTerminal
-> STM Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VirtualTerminal -> VirtualTerminalSettings
virtualSettings
    termGetCursorPosition :: VirtualTerminal -> IO Position
termGetCursorPosition = TVar Position -> IO Position
forall a. TVar a -> IO a
readTVarIO (TVar Position -> IO Position)
-> (VirtualTerminal -> TVar Position)
-> VirtualTerminal
-> IO Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VirtualTerminal -> TVar Position
virtualCursor

withVirtualTerminal :: (MonadIO m) => VirtualTerminalSettings -> (VirtualTerminal -> m a) -> m a
withVirtualTerminal :: forall (m :: * -> *) a.
MonadIO m =>
VirtualTerminalSettings -> (VirtualTerminal -> m a) -> m a
withVirtualTerminal VirtualTerminalSettings
settings VirtualTerminal -> m a
handler = do
    size <- IO Size -> m Size
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Size -> m Size) -> IO Size -> m Size
forall a b. (a -> b) -> a -> b
$ STM Size -> IO Size
forall a. STM a -> IO a
atomically (STM Size -> IO Size) -> STM Size -> IO Size
forall a b. (a -> b) -> a -> b
$ VirtualTerminalSettings -> STM Size
virtualWindowSize VirtualTerminalSettings
settings
    term <- liftIO $ atomically $ VirtualTerminal settings
        <$> newTVar (Position 0 0)
        <*> newTVar (replicate (height size) (replicate (width size) ' '))
        <*> newTVar True
        <*> newTVar False
    handler term

command :: VirtualTerminal -> Command -> STM ()
command :: VirtualTerminal -> Command -> STM ()
command VirtualTerminal
t = \case
    Command
PutLn                         -> VirtualTerminal -> STM ()
putLn VirtualTerminal
t
    PutText Text
s                     -> VirtualTerminal -> String -> STM ()
putString VirtualTerminal
t (Text -> String
T.unpack Text
s)
    SetAttribute Attribute
_                -> () -> STM ()
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    ResetAttribute Attribute
_              -> () -> STM ()
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Command
ResetAttributes               -> () -> STM ()
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    MoveCursorUp Int
i                -> VirtualTerminal -> Int -> STM ()
moveCursorVertical   VirtualTerminal
t (Int -> Int
forall a. Num a => a -> a
negate Int
i)
    MoveCursorDown Int
i              -> VirtualTerminal -> Int -> STM ()
moveCursorVertical   VirtualTerminal
t Int
i
    MoveCursorForward Int
i           -> VirtualTerminal -> Int -> STM ()
moveCursorHorizontal VirtualTerminal
t Int
i
    MoveCursorBackward Int
i          -> VirtualTerminal -> Int -> STM ()
moveCursorHorizontal VirtualTerminal
t (Int -> Int
forall a. Num a => a -> a
negate Int
i)
    Command
ShowCursor                    -> () -> STM ()
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Command
HideCursor                    -> () -> STM ()
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Command
SaveCursor                    -> () -> STM ()
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Command
RestoreCursor                 -> () -> STM ()
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Command
GetCursorPosition             -> VirtualTerminal -> STM ()
getCursorPosition VirtualTerminal
t
    SetCursorPosition Position
pos         -> VirtualTerminal -> Position -> STM ()
setCursorPosition VirtualTerminal
t Position
pos
    SetCursorRow Int
r                -> VirtualTerminal -> Int -> STM ()
setCursorRow VirtualTerminal
t Int
r
    SetCursorColumn Int
c             -> VirtualTerminal -> Int -> STM ()
setCursorColumn VirtualTerminal
t Int
c
    InsertChars Int
i                 -> VirtualTerminal -> Int -> STM ()
insertChars       VirtualTerminal
t Int
i
    DeleteChars Int
i                 -> VirtualTerminal -> Int -> STM ()
deleteChars       VirtualTerminal
t Int
i
    EraseChars  Int
i                 -> VirtualTerminal -> Int -> STM ()
eraseChars        VirtualTerminal
t Int
i
    InsertLines Int
i                 -> VirtualTerminal -> Int -> STM ()
insertLines       VirtualTerminal
t Int
i
    DeleteLines Int
i                 -> VirtualTerminal -> Int -> STM ()
deleteLines       VirtualTerminal
t Int
i
    EraseInLine EraseMode
m                 -> VirtualTerminal -> EraseMode -> STM ()
eraseInLine       VirtualTerminal
t EraseMode
m
    EraseInDisplay EraseMode
m              -> VirtualTerminal -> EraseMode -> STM ()
eraseInDisplay    VirtualTerminal
t EraseMode
m
    SetAutoWrap Bool
b                 -> VirtualTerminal -> Bool -> STM ()
setAutoWrap       VirtualTerminal
t Bool
b
    SetAlternateScreenBuffer Bool
b    -> VirtualTerminal -> Bool -> STM ()
setAlternateScreenBuffer VirtualTerminal
t Bool
b

scrollDown :: Int -> [String] -> [String]
scrollDown :: Int -> [String] -> [String]
scrollDown Int
w [String]
window =
    Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 [String]
window [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
w Char
' ']

putLn :: VirtualTerminal -> STM ()
putLn :: VirtualTerminal -> STM ()
putLn VirtualTerminal
t = do
    Size h w <- VirtualTerminalSettings -> STM Size
virtualWindowSize (VirtualTerminal -> VirtualTerminalSettings
virtualSettings VirtualTerminal
t)
    Position r _ <- readTVar (virtualCursor t)
    window <- readTVar (virtualWindow t)
    if r + 1 == h
        then do
            writeTVar (virtualCursor t) $ Position r 0
            writeTVar (virtualWindow t) (scrollDown w window)
        else do
            writeTVar (virtualCursor t) $ Position (r + 1) 0

putString :: VirtualTerminal -> String -> STM ()
putString :: VirtualTerminal -> String -> STM ()
putString VirtualTerminal
t String
s = do
    Size h w <- VirtualTerminalSettings -> STM Size
virtualWindowSize (VirtualTerminal -> VirtualTerminalSettings
virtualSettings VirtualTerminal
t)
    autoWrap <- readTVar (virtualAutoWrap t)
    Position r c <- readTVar (virtualCursor t)
    wndw <- readTVar (virtualWindow t)
    let cl = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
c -- space in cursor line
        f String
"" [String]
ls     = [String]
ls
        f String
x  []     = let k :: String
k = (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
w String
x) in (String
k String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
k) Char
' ') String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String] -> [String]
f (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
w String
x) []
        f String
x  (String
l:[String]
ls) = let k :: String
k = (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
w String
x) in (String
k String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
k) String
l)            String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String] -> [String]
f (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
w String
x) [String]
ls
        w1 = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
r [String]
wndw
        w2 = [Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
c String
l String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
k String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String -> String
forall a. Int -> [a] -> [a]
drop (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
k) String
l]
            where
                k :: String
k = Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
cl String
s
                l :: String
l = [String]
wndw [String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! Int
r
        w3  | Bool
autoWrap  = String -> [String] -> [String]
f (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
cl String
s) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [String]
wndw
            | Bool
otherwise =                 Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [String]
wndw
        w4 = [String]
w1 [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
w2 [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
w3
    writeTVar (virtualWindow t) (reverse $ take h $ reverse w4)
    if autoWrap
        then do
            let (r',c') = quotRem (r * w + c + length s) w
            writeTVar (virtualCursor t) $ Position (min r' (h - 1)) c'
        else do
            let (r', c') = (r, min (w - 1) (c + length s))
            writeTVar (virtualCursor t) $ Position r' c'

moveCursorHorizontal :: VirtualTerminal -> Int -> STM ()
moveCursorHorizontal :: VirtualTerminal -> Int -> STM ()
moveCursorHorizontal VirtualTerminal
t Int
i = do
    Size _ w <- VirtualTerminalSettings -> STM Size
virtualWindowSize (VirtualTerminal -> VirtualTerminalSettings
virtualSettings VirtualTerminal
t)
    Position r c <- readTVar (virtualCursor t)
    writeTVar (virtualCursor t) $ Position r (max 0 $ min (w - 1) $ c + i)

moveCursorVertical :: VirtualTerminal -> Int -> STM ()
moveCursorVertical :: VirtualTerminal -> Int -> STM ()
moveCursorVertical VirtualTerminal
t Int
i = do
    Size h _ <- VirtualTerminalSettings -> STM Size
virtualWindowSize (VirtualTerminal -> VirtualTerminalSettings
virtualSettings VirtualTerminal
t)
    Position r c <- readTVar (virtualCursor t)
    writeTVar (virtualCursor t) $ Position (max 0 $ min (h - 1) $ r + i) c

getCursorPosition :: VirtualTerminal -> STM ()
getCursorPosition :: VirtualTerminal -> STM ()
getCursorPosition VirtualTerminal
_ = () -> STM ()
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

setCursorPosition :: VirtualTerminal -> Position -> STM ()
setCursorPosition :: VirtualTerminal -> Position -> STM ()
setCursorPosition VirtualTerminal
t (Position Int
r Int
c) = do
    Size h w <- VirtualTerminalSettings -> STM Size
virtualWindowSize (VirtualTerminal -> VirtualTerminalSettings
virtualSettings VirtualTerminal
t)
    writeTVar (virtualCursor t) $ Position (max 0 (min (h - 1) r)) (max 0 (min (w - 1) c))

setCursorRow :: VirtualTerminal -> Int -> STM ()
setCursorRow :: VirtualTerminal -> Int -> STM ()
setCursorRow VirtualTerminal
t Int
r = do
    Size h _ <- VirtualTerminalSettings -> STM Size
virtualWindowSize (VirtualTerminal -> VirtualTerminalSettings
virtualSettings VirtualTerminal
t)
    Position _ c <- readTVar (virtualCursor t)
    writeTVar (virtualCursor t) $ Position (max 0 (min (h - 1) r)) c

setCursorColumn :: VirtualTerminal -> Int -> STM ()
setCursorColumn :: VirtualTerminal -> Int -> STM ()
setCursorColumn VirtualTerminal
t Int
c = do
    Size _ w <- VirtualTerminalSettings -> STM Size
virtualWindowSize (VirtualTerminal -> VirtualTerminalSettings
virtualSettings VirtualTerminal
t)
    Position r _ <- readTVar (virtualCursor t)
    writeTVar (virtualCursor t) $ Position r (max 0 (min (w - 1) c))

insertChars :: VirtualTerminal -> Int -> STM ()
insertChars :: VirtualTerminal -> Int -> STM ()
insertChars VirtualTerminal
t Int
i = do
    Size _ w <- VirtualTerminalSettings -> STM Size
virtualWindowSize (VirtualTerminal -> VirtualTerminalSettings
virtualSettings VirtualTerminal
t)
    Position r c <- readTVar (virtualCursor t)
    wndw  <- readTVar (virtualWindow t)
    let l  = [String]
wndw [String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! Int
r
        w1 = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
r [String]
wndw
        w2 = [Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
w (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
c String
l String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
i Char
' ' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
c String
l]
        w3 = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [String]
wndw
    writeTVar (virtualWindow t) (w1 <> w2 <> w3)

deleteChars :: VirtualTerminal -> Int -> STM ()
deleteChars :: VirtualTerminal -> Int -> STM ()
deleteChars VirtualTerminal
t Int
i = do
    Position r c <- TVar Position -> STM Position
forall a. TVar a -> STM a
readTVar (VirtualTerminal -> TVar Position
virtualCursor VirtualTerminal
t)
    wndw  <- readTVar (virtualWindow t)
    let l  = [String]
wndw [String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! Int
r
        w1 = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
r [String]
wndw
        w2 = [Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
c String
l String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String -> String
forall a. Int -> [a] -> [a]
drop (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) String
l String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
i Char
' ']
        w3 = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [String]
wndw
    writeTVar (virtualWindow t) (w1 <> w2 <> w3)

eraseChars :: VirtualTerminal -> Int -> STM ()
eraseChars :: VirtualTerminal -> Int -> STM ()
eraseChars VirtualTerminal
t Int
i = do
    Position r c <- TVar Position -> STM Position
forall a. TVar a -> STM a
readTVar (VirtualTerminal -> TVar Position
virtualCursor VirtualTerminal
t)
    wndw  <- readTVar (virtualWindow t)
    let l  = [String]
wndw [String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! Int
r
        w1 = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
r [String]
wndw
        w2 = [Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
c String
l String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
i Char
' ' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String -> String
forall a. Int -> [a] -> [a]
drop (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) String
l]
        w3 = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [String]
wndw
    writeTVar (virtualWindow t) (w1 <> w2 <> w3)

insertLines :: VirtualTerminal -> Int -> STM ()
insertLines :: VirtualTerminal -> Int -> STM ()
insertLines VirtualTerminal
t Int
i = do
    Size h w <- VirtualTerminalSettings -> STM Size
virtualWindowSize (VirtualTerminal -> VirtualTerminalSettings
virtualSettings VirtualTerminal
t)
    Position r _ <- readTVar (virtualCursor t)
    wndw  <- readTVar (virtualWindow t)
    let w1 = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
r [String]
wndw
        w2 = Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
i (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
w Char
' ')
        w3 = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
r [String]
wndw
    writeTVar (virtualWindow t) (w1 <> w2 <> w3)

deleteLines :: VirtualTerminal -> Int -> STM ()
deleteLines :: VirtualTerminal -> Int -> STM ()
deleteLines VirtualTerminal
t Int
i = do
    Size h w <- VirtualTerminalSettings -> STM Size
virtualWindowSize (VirtualTerminal -> VirtualTerminalSettings
virtualSettings VirtualTerminal
t)
    Position r _ <- readTVar (virtualCursor t)
    wndw  <- readTVar (virtualWindow t)
    let w1 = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
r [String]
wndw
        w2 = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
r [String]
wndw
        w3 = Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
i (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
w Char
' ')
    writeTVar (virtualWindow t) (w1 <> w2 <> w3)

eraseInLine :: VirtualTerminal -> EraseMode -> STM ()
eraseInLine :: VirtualTerminal -> EraseMode -> STM ()
eraseInLine VirtualTerminal
t EraseMode
m = do
    Size _ w <- VirtualTerminalSettings -> STM Size
virtualWindowSize (VirtualTerminal -> VirtualTerminalSettings
virtualSettings VirtualTerminal
t)
    Position r c <- readTVar (virtualCursor t)
    wndw  <- readTVar (virtualWindow t)
    let l  = [String]
wndw [String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! Int
r
        w1 = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
r [String]
wndw
        w2 = case EraseMode
m of
                EraseMode
EraseBackward -> [Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Char
' ' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String -> String
forall a. Int -> [a] -> [a]
drop (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String
l]
                EraseMode
EraseForward  -> [Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
c String
l String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
c) Char
' ']
                EraseMode
EraseAll      -> [Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
w Char
' ']
        w3 = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [String]
wndw
    writeTVar (virtualWindow t) (w1 <> w2 <> w3)

eraseInDisplay :: VirtualTerminal -> EraseMode -> STM ()
eraseInDisplay :: VirtualTerminal -> EraseMode -> STM ()
eraseInDisplay VirtualTerminal
t EraseMode
m = do
    Size h w <- VirtualTerminalSettings -> STM Size
virtualWindowSize (VirtualTerminal -> VirtualTerminalSettings
virtualSettings VirtualTerminal
t)
    Position r _ <- readTVar (virtualCursor t)
    wndw  <- readTVar (virtualWindow t)
    let w1  = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
r [String]
wndw
        w1E = Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
r (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
w Char
' ') 
        w2  = [[String]
wndw [String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! Int
r]
        w2E = [Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
w Char
' ']
        w3  = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [String]
wndw
        w3E = Int -> String -> [String]
forall a. Int -> a -> [a]
replicate (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
w Char
' ')
    writeTVar (virtualWindow t) $ case m of
        EraseMode
EraseBackward -> [String]
w1E [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
w2  [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
w3
        EraseMode
EraseForward  -> [String]
w1  [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
w2  [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
w3E
        EraseMode
EraseAll      -> [String]
w1E [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
w2E [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
w3E

setAutoWrap :: VirtualTerminal -> Bool -> STM ()
setAutoWrap :: VirtualTerminal -> Bool -> STM ()
setAutoWrap VirtualTerminal
t Bool
b = do
    TVar Bool -> Bool -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (VirtualTerminal -> TVar Bool
virtualAutoWrap VirtualTerminal
t) Bool
b

setAlternateScreenBuffer :: VirtualTerminal -> Bool -> STM ()
setAlternateScreenBuffer :: VirtualTerminal -> Bool -> STM ()
setAlternateScreenBuffer VirtualTerminal
t Bool
b = do
    TVar Bool -> Bool -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (VirtualTerminal -> TVar Bool
virtualAlternateScreenBuffer VirtualTerminal
t) Bool
b