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
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
    VirtualTerminal
term <- IO VirtualTerminal -> m VirtualTerminal
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VirtualTerminal -> m VirtualTerminal)
-> IO VirtualTerminal -> m VirtualTerminal
forall a b. (a -> b) -> a -> b
$ STM VirtualTerminal -> IO VirtualTerminal
forall a. STM a -> IO a
atomically (STM VirtualTerminal -> IO VirtualTerminal)
-> STM VirtualTerminal -> IO VirtualTerminal
forall a b. (a -> b) -> a -> b
$ VirtualTerminalSettings
-> TVar Position
-> TVar [String]
-> TVar Bool
-> TVar Bool
-> VirtualTerminal
VirtualTerminal VirtualTerminalSettings
settings
        (TVar Position
 -> TVar [String] -> TVar Bool -> TVar Bool -> VirtualTerminal)
-> STM (TVar Position)
-> STM (TVar [String] -> TVar Bool -> TVar Bool -> VirtualTerminal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Position -> STM (TVar Position)
forall a. a -> STM (TVar a)
newTVar (Int -> Int -> Position
Position Int
0 Int
0)
        STM (TVar [String] -> TVar Bool -> TVar Bool -> VirtualTerminal)
-> STM (TVar [String])
-> STM (TVar Bool -> TVar Bool -> VirtualTerminal)
forall a b. STM (a -> b) -> STM a -> STM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [String] -> STM (TVar [String])
forall a. a -> STM (TVar a)
newTVar (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate (Size -> Int
height Size
size) (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Size -> Int
width Size
size) Char
' '))
        STM (TVar Bool -> TVar Bool -> VirtualTerminal)
-> STM (TVar Bool) -> STM (TVar Bool -> VirtualTerminal)
forall a b. STM (a -> b) -> STM a -> STM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> STM (TVar Bool)
forall a. a -> STM (TVar a)
newTVar Bool
True
        STM (TVar Bool -> VirtualTerminal)
-> STM (TVar Bool) -> STM VirtualTerminal
forall a b. STM (a -> b) -> STM a -> STM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> STM (TVar Bool)
forall a. a -> STM (TVar a)
newTVar Bool
False
    VirtualTerminal -> m a
handler VirtualTerminal
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 Int
h Int
w <- VirtualTerminalSettings -> STM Size
virtualWindowSize (VirtualTerminal -> VirtualTerminalSettings
virtualSettings VirtualTerminal
t)
    Position Int
r Int
_ <- TVar Position -> STM Position
forall a. TVar a -> STM a
readTVar (VirtualTerminal -> TVar Position
virtualCursor VirtualTerminal
t)
    [String]
window <- TVar [String] -> STM [String]
forall a. TVar a -> STM a
readTVar (VirtualTerminal -> TVar [String]
virtualWindow VirtualTerminal
t)
    if Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
h
        then do
            TVar Position -> Position -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (VirtualTerminal -> TVar Position
virtualCursor VirtualTerminal
t) (Position -> STM ()) -> Position -> STM ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Position
Position Int
r Int
0
            TVar [String] -> [String] -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (VirtualTerminal -> TVar [String]
virtualWindow VirtualTerminal
t) (Int -> [String] -> [String]
scrollDown Int
w [String]
window)
        else do
            TVar Position -> Position -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (VirtualTerminal -> TVar Position
virtualCursor VirtualTerminal
t) (Position -> STM ()) -> Position -> STM ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Position
Position (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
0

putString :: VirtualTerminal -> String -> STM ()
putString :: VirtualTerminal -> String -> STM ()
putString VirtualTerminal
t String
s = do
    Size Int
h Int
w <- VirtualTerminalSettings -> STM Size
virtualWindowSize (VirtualTerminal -> VirtualTerminalSettings
virtualSettings VirtualTerminal
t)
    Bool
autoWrap <- TVar Bool -> STM Bool
forall a. TVar a -> STM a
readTVar (VirtualTerminal -> TVar Bool
virtualAutoWrap VirtualTerminal
t)
    Position Int
r Int
c <- TVar Position -> STM Position
forall a. TVar a -> STM a
readTVar (VirtualTerminal -> TVar Position
virtualCursor VirtualTerminal
t)
    [String]
wndw <- TVar [String] -> STM [String]
forall a. TVar a -> STM a
readTVar (VirtualTerminal -> TVar [String]
virtualWindow VirtualTerminal
t)
    let cl :: Int
cl = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
c -- space in cursor line
        f :: String -> [String] -> [String]
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 :: [String]
w1 = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
r [String]
wndw
        w2 :: [String]
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 :: [String]
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]
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
    TVar [String] -> [String] -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (VirtualTerminal -> TVar [String]
virtualWindow VirtualTerminal
t) ([String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
h ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. [a] -> [a]
reverse [String]
w4)
    if Bool
autoWrap
        then do
            let (Int
r',Int
c') = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
quotRem (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 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
s) Int
w
            TVar Position -> Position -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (VirtualTerminal -> TVar Position
virtualCursor VirtualTerminal
t) (Position -> STM ()) -> Position -> STM ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Position
Position (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
r' (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Int
c'
        else do
            let (Int
r', Int
c') = (Int
r, Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (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
s))
            TVar Position -> Position -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (VirtualTerminal -> TVar Position
virtualCursor VirtualTerminal
t) (Position -> STM ()) -> Position -> STM ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Position
Position Int
r' Int
c'

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

moveCursorVertical :: VirtualTerminal -> Int -> STM ()
moveCursorVertical :: VirtualTerminal -> Int -> STM ()
moveCursorVertical VirtualTerminal
t Int
i = do
    Size Int
h Int
_ <- VirtualTerminalSettings -> STM Size
virtualWindowSize (VirtualTerminal -> VirtualTerminalSettings
virtualSettings VirtualTerminal
t)
    Position Int
r Int
c <- TVar Position -> STM Position
forall a. TVar a -> STM a
readTVar (VirtualTerminal -> TVar Position
virtualCursor VirtualTerminal
t)
    TVar Position -> Position -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (VirtualTerminal -> TVar Position
virtualCursor VirtualTerminal
t) (Position -> STM ()) -> Position -> STM ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Position
Position (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) Int
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 Int
h Int
w <- VirtualTerminalSettings -> STM Size
virtualWindowSize (VirtualTerminal -> VirtualTerminalSettings
virtualSettings VirtualTerminal
t)
    TVar Position -> Position -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (VirtualTerminal -> TVar Position
virtualCursor VirtualTerminal
t) (Position -> STM ()) -> Position -> STM ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Position
Position (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
r)) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
c))

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

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

insertChars :: VirtualTerminal -> Int -> STM ()
insertChars :: VirtualTerminal -> Int -> STM ()
insertChars VirtualTerminal
t Int
i = do
    Size Int
_ Int
w <- VirtualTerminalSettings -> STM Size
virtualWindowSize (VirtualTerminal -> VirtualTerminalSettings
virtualSettings VirtualTerminal
t)
    Position Int
r Int
c <- TVar Position -> STM Position
forall a. TVar a -> STM a
readTVar (VirtualTerminal -> TVar Position
virtualCursor VirtualTerminal
t)
    [String]
wndw  <- TVar [String] -> STM [String]
forall a. TVar a -> STM a
readTVar (VirtualTerminal -> TVar [String]
virtualWindow VirtualTerminal
t)
    let l :: String
l  = [String]
wndw [String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! Int
r
        w1 :: [String]
w1 = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
r [String]
wndw
        w2 :: [String]
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 :: [String]
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
    TVar [String] -> [String] -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (VirtualTerminal -> TVar [String]
virtualWindow VirtualTerminal
t) ([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)

deleteChars :: VirtualTerminal -> Int -> STM ()
deleteChars :: VirtualTerminal -> Int -> STM ()
deleteChars VirtualTerminal
t Int
i = do
    Position Int
r Int
c <- TVar Position -> STM Position
forall a. TVar a -> STM a
readTVar (VirtualTerminal -> TVar Position
virtualCursor VirtualTerminal
t)
    [String]
wndw  <- TVar [String] -> STM [String]
forall a. TVar a -> STM a
readTVar (VirtualTerminal -> TVar [String]
virtualWindow VirtualTerminal
t)
    let l :: String
l  = [String]
wndw [String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! Int
r
        w1 :: [String]
w1 = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
r [String]
wndw
        w2 :: [String]
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 :: [String]
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
    TVar [String] -> [String] -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (VirtualTerminal -> TVar [String]
virtualWindow VirtualTerminal
t) ([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)

eraseChars :: VirtualTerminal -> Int -> STM ()
eraseChars :: VirtualTerminal -> Int -> STM ()
eraseChars VirtualTerminal
t Int
i = do
    Position Int
r Int
c <- TVar Position -> STM Position
forall a. TVar a -> STM a
readTVar (VirtualTerminal -> TVar Position
virtualCursor VirtualTerminal
t)
    [String]
wndw  <- TVar [String] -> STM [String]
forall a. TVar a -> STM a
readTVar (VirtualTerminal -> TVar [String]
virtualWindow VirtualTerminal
t)
    let l :: String
l  = [String]
wndw [String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! Int
r
        w1 :: [String]
w1 = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
r [String]
wndw
        w2 :: [String]
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 :: [String]
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
    TVar [String] -> [String] -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (VirtualTerminal -> TVar [String]
virtualWindow VirtualTerminal
t) ([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)

insertLines :: VirtualTerminal -> Int -> STM ()
insertLines :: VirtualTerminal -> Int -> STM ()
insertLines VirtualTerminal
t Int
i = do
    Size Int
h Int
w <- VirtualTerminalSettings -> STM Size
virtualWindowSize (VirtualTerminal -> VirtualTerminalSettings
virtualSettings VirtualTerminal
t)
    Position Int
r Int
_ <- TVar Position -> STM Position
forall a. TVar a -> STM a
readTVar (VirtualTerminal -> TVar Position
virtualCursor VirtualTerminal
t)
    [String]
wndw  <- TVar [String] -> STM [String]
forall a. TVar a -> STM a
readTVar (VirtualTerminal -> TVar [String]
virtualWindow VirtualTerminal
t)
    let w1 :: [String]
w1 = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
r [String]
wndw
        w2 :: [String]
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 :: [String]
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
    TVar [String] -> [String] -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (VirtualTerminal -> TVar [String]
virtualWindow VirtualTerminal
t) ([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)

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

eraseInLine :: VirtualTerminal -> EraseMode -> STM ()
eraseInLine :: VirtualTerminal -> EraseMode -> STM ()
eraseInLine VirtualTerminal
t EraseMode
m = do
    Size Int
_ Int
w <- VirtualTerminalSettings -> STM Size
virtualWindowSize (VirtualTerminal -> VirtualTerminalSettings
virtualSettings VirtualTerminal
t)
    Position Int
r Int
c <- TVar Position -> STM Position
forall a. TVar a -> STM a
readTVar (VirtualTerminal -> TVar Position
virtualCursor VirtualTerminal
t)
    [String]
wndw  <- TVar [String] -> STM [String]
forall a. TVar a -> STM a
readTVar (VirtualTerminal -> TVar [String]
virtualWindow VirtualTerminal
t)
    let l :: String
l  = [String]
wndw [String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! Int
r
        w1 :: [String]
w1 = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
r [String]
wndw
        w2 :: [String]
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 :: [String]
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
    TVar [String] -> [String] -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (VirtualTerminal -> TVar [String]
virtualWindow VirtualTerminal
t) ([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)

eraseInDisplay :: VirtualTerminal -> EraseMode -> STM ()
eraseInDisplay :: VirtualTerminal -> EraseMode -> STM ()
eraseInDisplay VirtualTerminal
t EraseMode
m = do
    Size Int
h Int
w <- VirtualTerminalSettings -> STM Size
virtualWindowSize (VirtualTerminal -> VirtualTerminalSettings
virtualSettings VirtualTerminal
t)
    Position Int
r Int
_ <- TVar Position -> STM Position
forall a. TVar a -> STM a
readTVar (VirtualTerminal -> TVar Position
virtualCursor VirtualTerminal
t)
    [String]
wndw  <- TVar [String] -> STM [String]
forall a. TVar a -> STM a
readTVar (VirtualTerminal -> TVar [String]
virtualWindow VirtualTerminal
t)
    let w1 :: [String]
w1  = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
r [String]
wndw
        w1E :: [String]
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]
w2  = [[String]
wndw [String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! Int
r]
        w2E :: [String]
w2E = [Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
w Char
' ']
        w3 :: [String]
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 :: [String]
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
' ')
    TVar [String] -> [String] -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (VirtualTerminal -> TVar [String]
virtualWindow VirtualTerminal
t) ([String] -> STM ()) -> [String] -> STM ()
forall a b. (a -> b) -> a -> b
$ case EraseMode
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