{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}

module System.Terminal.Emulator.Term.Process
  ( Term,
    TermLine,
    processTermAtoms,
  )
where

import Control.Category ((>>>))
import Control.Lens
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC8
import Data.Foldable (foldl')
import Data.List (iterate')
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as VU
import qualified System.Console.ANSI.Types as SGR
import System.Terminal.Emulator.Attrs (Attrs, attrsBg, attrsFg, attrsIntensity, attrsUnderline, blankAttrs)
import System.Terminal.Emulator.DECPrivateMode (DECPrivateMode)
import qualified System.Terminal.Emulator.DECPrivateMode as DECPrivateMode
import System.Terminal.Emulator.KeyboardInput (KeyboardState (keyboardState_CRLF, keyboardState_DECCKM, keyboardState_Locked))
import System.Terminal.Emulator.Parsing.Types (ControlSequenceIntroducer (..), DeviceStatusReport (..), EraseInDisplayParam (..), EraseInLineParam (..), EscapeSequence (..), Mode (..), OperatingSystemCommand (..), SendDeviceAttributesSecondary (RequestTerminalIdentificationCode), SingleCharacterFunction (..), TermAtom (..), WindowManipulation (..))
import System.Terminal.Emulator.Term (Term, activeScreen, addScrollBackLines, altScreenActive, cursorLine, cursorPos, cursorState, insertMode, keyboardState, mkTerm, modeWrap, numCols, numRows, origin, scrollBackLines, scrollBottom, scrollTop, termAttrs, termScreen, vuIndex, windowTitle, wrapNext)
import System.Terminal.Emulator.TermLines (TermLine)
import qualified System.Terminal.Emulator.TermLines as TL
import Prelude hiding (lines)

processTermAtoms :: [TermAtom] -> Term -> (ByteString, Term)
processTermAtoms :: [TermAtom] -> Term -> (ByteString, Term)
processTermAtoms [TermAtom]
termAtoms Term
term =
  ((ByteString, Term) -> TermAtom -> (ByteString, Term))
-> (ByteString, Term) -> [TermAtom] -> (ByteString, Term)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
    ( \(!ByteString
w1, !Term
t) TermAtom
termAtom ->
        let (!ByteString
w2, !Term
t') = TermAtom -> Term -> (ByteString, Term)
processTermAtom TermAtom
termAtom Term
t
         in (ByteString
w1 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
w2, Term
t')
    )
    (ByteString
B.empty, Term
term)
    [TermAtom]
termAtoms

processTermAtom :: TermAtom -> Term -> (ByteString, Term)
processTermAtom :: TermAtom -> Term -> (ByteString, Term)
processTermAtom (TermAtom_VisibleChar Char
char) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ Char -> Term -> Term
processVisibleChar Char
char
processTermAtom (TermAtom_SingleCharacterFunction SingleCharacterFunction
Control_Bell) = (Term -> Term) -> Term -> (ByteString, Term)
nw Term -> Term
forall a. a -> a
id -- TODO
processTermAtom (TermAtom_SingleCharacterFunction SingleCharacterFunction
Control_Backspace) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ \Term
term -> (Int, Int) -> Term -> Term
cursorMoveTo (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1, (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Term
term
processTermAtom (TermAtom_SingleCharacterFunction SingleCharacterFunction
Control_Tab) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ Int -> Term -> Term
putTabs Int
1
processTermAtom (TermAtom_SingleCharacterFunction SingleCharacterFunction
Control_LineFeed) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ Term -> Term
processLF
processTermAtom (TermAtom_SingleCharacterFunction SingleCharacterFunction
Control_VerticalTab) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ Term -> Term
processLF
processTermAtom (TermAtom_SingleCharacterFunction SingleCharacterFunction
Control_FormFeed) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ Term -> Term
processLF
processTermAtom (TermAtom_SingleCharacterFunction SingleCharacterFunction
Control_CarriageReturn) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ \Term
term -> (Int, Int) -> Term -> Term
cursorMoveTo (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1, Int
0) Term
term
processTermAtom (TermAtom_SingleCharacterFunction SingleCharacterFunction
Control_ReturnTerminalStatus) = (Term -> Term) -> Term -> (ByteString, Term)
nw Term -> Term
forall a. a -> a
id
processTermAtom (TermAtom_SingleCharacterFunction SingleCharacterFunction
Control_SwitchToStandardCharacterSet) = (Term -> Term) -> Term -> (ByteString, Term)
nw Term -> Term
forall a. a -> a
id
processTermAtom (TermAtom_SingleCharacterFunction SingleCharacterFunction
Control_SwitchToAlternateCharacterSet) = (Term -> Term) -> Term -> (ByteString, Term)
nw Term -> Term
forall a. a -> a
id
processTermAtom (TermAtom_EscapeSequence EscapeSequence
escapeSequence) = EscapeSequence -> Term -> (ByteString, Term)
processEscapeSequence EscapeSequence
escapeSequence
processTermAtom (TermAtom_SingleCharacterFunctionUnknown Char
x) = [Char] -> Term -> (ByteString, Term)
forall a. HasCallStack => [Char] -> a
error ([Char] -> Term -> (ByteString, Term))
-> [Char] -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ [Char]
"Unknown Character Function: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Char -> [Char]
forall a. Show a => a -> [Char]
show Char
x
processTermAtom (TermAtom_EscapeSequenceUnknown Text
x)
  | Text -> Bool
isExpectedInvalidEscSequence Text
x = (Term -> Term) -> Term -> (ByteString, Term)
nw Term -> Term
forall a. a -> a
id
  | Bool
otherwise = [Char] -> Term -> (ByteString, Term)
forall a. HasCallStack => [Char] -> a
error ([Char] -> Term -> (ByteString, Term))
-> [Char] -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ [Char]
"Unknown ESC seq: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
forall a. Show a => a -> [Char]
show Text
x

-- | No-write operation
nw :: (Term -> Term) -> Term -> (ByteString, Term)
nw :: (Term -> Term) -> Term -> (ByteString, Term)
nw Term -> Term
f Term
term = (ByteString
B.empty, Term -> Term
f Term
term)

-- | I have observed some invalid ESC sequences in the wild, that I am
-- deciding to ignore for now
isExpectedInvalidEscSequence :: Text -> Bool
isExpectedInvalidEscSequence :: Text -> Bool
isExpectedInvalidEscSequence Text
str
  | (Text
"\ESC[" Text -> Text -> Bool
`T.isPrefixOf` Text
str) Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r') Text
str = Bool
True
  | Text
str Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"\ESC\r" = Bool
True
  | Bool
otherwise = Bool
False

processEscapeSequence :: EscapeSequence -> Term -> (ByteString, Term)
processEscapeSequence :: EscapeSequence -> Term -> (ByteString, Term)
processEscapeSequence EscapeSequence
Esc_ReverseIndex = (Term -> Term) -> Term -> (ByteString, Term)
nw Term -> Term
reverseIndex
processEscapeSequence EscapeSequence
Esc_RIS = (Term -> Term) -> Term -> (ByteString, Term)
nw Term -> Term
forall a. a -> a
id -- TODO
processEscapeSequence EscapeSequence
Esc_DECPAM = (Term -> Term) -> Term -> (ByteString, Term)
nw Term -> Term
forall a. a -> a
id -- TODO
processEscapeSequence EscapeSequence
Esc_DECPNM = (Term -> Term) -> Term -> (ByteString, Term)
nw Term -> Term
forall a. a -> a
id -- TODO
processEscapeSequence (ESC_SetG0CharacterSet Text
_) = (Term -> Term) -> Term -> (ByteString, Term)
nw Term -> Term
forall a. a -> a
id -- Ignore
processEscapeSequence (Esc_CSI (CSI_CursorUp Int
n)) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ \Term
term -> (Int, Int) -> Term -> Term
cursorMoveTo ((Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n, Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2) Term
term
processEscapeSequence (Esc_CSI (CSI_CursorDown Int
n)) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ \Term
term -> (Int, Int) -> Term -> Term
cursorMoveTo ((Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n, Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2) Term
term
processEscapeSequence (Esc_CSI (CSI_LinePositionRelative Int
n)) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ \Term
term -> (Int, Int) -> Term -> Term
cursorMoveTo ((Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n, Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2) Term
term
processEscapeSequence (Esc_CSI (CSI_CharacterPositionRelative Int
n)) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ \Term
term -> (Int, Int) -> Term -> Term
cursorMoveTo (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1, (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) Term
term
processEscapeSequence (Esc_CSI (CSI_CursorForward Int
n)) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ \Term
term -> (Int, Int) -> Term -> Term
cursorMoveTo (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1, (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) Term
term
processEscapeSequence (Esc_CSI (CSI_CursorBack Int
n)) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ \Term
term -> (Int, Int) -> Term -> Term
cursorMoveTo (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1, (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) Term
term
processEscapeSequence (Esc_CSI (CSI_EraseInLine EraseInLineParam
param)) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ EraseInLineParam -> Term -> Term
eraseInLine EraseInLineParam
param
processEscapeSequence (Esc_CSI (CSI_EraseCharacters Int
n)) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ Int -> Term -> Term
eraseCharacters Int
n
processEscapeSequence (Esc_CSI (CSI_InsertBlankCharacters Int
n)) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ Int -> Term -> Term
insertBlankChars Int
n
processEscapeSequence (Esc_CSI (CSI_InsertBlankLines Int
n)) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ Int -> Term -> Term
insertBlankLines Int
n
processEscapeSequence (Esc_CSI (CSI_DeleteChars Int
n)) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ Int -> Term -> Term
deleteChars Int
n
processEscapeSequence (Esc_CSI (CSI_DeleteLines Int
n)) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ Int -> Term -> Term
deleteLines Int
n
processEscapeSequence (Esc_CSI (CSI_CursorCharacterAbsolute Int
col)) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ \Term
term -> (Int, Int) -> Term -> Term
cursorMoveTo (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1, Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Term
term
processEscapeSequence (Esc_CSI (CSI_CharacterPositionAbsolute Int
col)) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ \Term
term -> (Int, Int) -> Term -> Term
cursorMoveTo (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1, Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Term
term
processEscapeSequence (Esc_CSI (CSI_CursorPosition Int
row Int
col)) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Term -> Term
cursorMoveAbsoluteTo (Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
processEscapeSequence (Esc_CSI (CSI_HorizontalVerticalPosition Int
row Int
col)) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Term -> Term
cursorMoveAbsoluteTo (Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
processEscapeSequence (Esc_CSI (CSI_LinePositionAbsolute Int
row)) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ \Term
term -> (Int, Int) -> Term -> Term
cursorMoveAbsoluteTo (Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2) Term
term
processEscapeSequence (Esc_CSI (CSI_ScrollUp Int
n)) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ \Term
term -> Int -> Int -> Term -> Term
scrollUp (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
scrollTop) Int
n Term
term
processEscapeSequence (Esc_CSI (CSI_ScrollDown Int
n)) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ \Term
term -> Int -> Int -> Term -> Term
scrollDown (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
scrollTop) Int
n Term
term
processEscapeSequence (Esc_CSI (CSI_EraseInDisplay EraseInDisplayParam
param)) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ EraseInDisplayParam -> Term -> Term
eraseInDisplay EraseInDisplayParam
param
processEscapeSequence (Esc_CSI (CSI_WindowManipulation WindowManipulation
param)) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ WindowManipulation -> Term -> Term
windowManipulation WindowManipulation
param
processEscapeSequence (Esc_CSI (CSI_DeviceStatusReport DeviceStatusReport
param)) = DeviceStatusReport -> Term -> (ByteString, Term)
deviceStatusReport DeviceStatusReport
param
processEscapeSequence (Esc_CSI (ControlSequenceIntroducer
CSI_SoftTerminalReset)) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ Term -> Term
softTerminalReset
processEscapeSequence (Esc_CSI (CSI_SetMode Mode
param)) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ Mode -> Term -> Term
setMode Mode
param
processEscapeSequence (Esc_CSI (CSI_ResetMode Mode
param)) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ Mode -> Term -> Term
resetMode Mode
param
processEscapeSequence (Esc_CSI (ControlSequenceIntroducer
CSI_SendDeviceAttributes)) = Term -> (ByteString, Term)
sendDeviceAttributes
processEscapeSequence (Esc_CSI (CSI_SendDeviceAttributesSecondary SendDeviceAttributesSecondary
param)) = SendDeviceAttributesSecondary -> Term -> (ByteString, Term)
sendDeviceAttributesSecondary SendDeviceAttributesSecondary
param
processEscapeSequence (Esc_CSI (CSI_RequestDECPrivateMode Int
_i)) = (Term -> Term) -> Term -> (ByteString, Term)
nw Term -> Term
forall a. a -> a
id -- TODO (?)
processEscapeSequence (Esc_CSI (CSI_DECSTBM Maybe Int
top Maybe Int
bottom)) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ (Maybe Int -> Maybe Int -> Term -> Term
setScrollingRegion Maybe Int
top Maybe Int
bottom) (Term -> Term) -> (Term -> Term) -> Term -> Term
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Int, Int) -> Term -> Term
cursorMoveAbsoluteTo (Int
0, Int
0)
processEscapeSequence (Esc_CSI (CSI_DECSET DECPrivateMode
decset)) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ DECPrivateMode -> Term -> Term
termProcessDecset DECPrivateMode
decset
processEscapeSequence (Esc_CSI (CSI_DECSET_Unknown Int
_code)) = (Term -> Term) -> Term -> (ByteString, Term)
nw Term -> Term
forall a. a -> a
id -- TODO Log this
processEscapeSequence (Esc_CSI (CSI_DECRST DECPrivateMode
decset)) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ DECPrivateMode -> Term -> Term
termProcessDecrst DECPrivateMode
decset
processEscapeSequence (Esc_CSI (CSI_DECRST_Unknown Int
_code)) = (Term -> Term) -> Term -> (ByteString, Term)
nw Term -> Term
forall a. a -> a
id -- TODO Log this
processEscapeSequence (Esc_CSI (CSI_SGR Vector SGR
sgrs)) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ \Term
term -> (Term -> SGR -> Term) -> Term -> Vector SGR -> Term
forall a b. (a -> b -> a) -> a -> Vector b -> a
V.foldl' ((SGR -> Term -> Term) -> Term -> SGR -> Term
forall a b c. (a -> b -> c) -> b -> a -> c
flip SGR -> Term -> Term
termProcessSGR) Term
term Vector SGR
sgrs
processEscapeSequence (Esc_OSC OperatingSystemCommand
osc) = OperatingSystemCommand -> Term -> (ByteString, Term)
processOsc OperatingSystemCommand
osc

putTabs :: Int -> Term -> Term
putTabs :: Int -> Term -> Term
putTabs Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = \Term
term -> ((Term -> Term) -> Term -> [Term]
forall a. (a -> a) -> a -> [a]
iterate' Term -> Term
putTabForward Term
term) [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! Int
n
  | Bool
otherwise = \Term
term -> ((Term -> Term) -> Term -> [Term]
forall a. (a -> a) -> a -> [a]
iterate' Term -> Term
putTabBackward Term
term) [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! (Int -> Int
forall a. Num a => a -> a
negate Int
n)
  where
    tabspaces :: Int
tabspaces = Int
8
    putTabForward :: Term -> Term
    putTabForward :: Term -> Term
putTabForward Term
term = ((((Int, Int) -> Identity (Int, Int)) -> Term -> Identity Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Identity (Int, Int)) -> Term -> Identity Term)
-> ((Int -> Identity Int) -> (Int, Int) -> Identity (Int, Int))
-> (Int -> Identity Int)
-> Term
-> Identity Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Identity Int) -> (Int, Int) -> Identity (Int, Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2) ((Int -> Identity Int) -> Term -> Identity Term)
-> Int -> Term -> Term
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Int -> Int -> Int -> Int
limit Int
0 (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
numCols Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
col')) Term
term
      where
        col :: Int
col = Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2
        col' :: Int
col' = ((Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tabspaces) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
tabspaces) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
tabspaces
    putTabBackward :: Term -> Term
    putTabBackward :: Term -> Term
putTabBackward Term
term
      | Int
col Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Term
term
      | Bool
otherwise = ((((Int, Int) -> Identity (Int, Int)) -> Term -> Identity Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Identity (Int, Int)) -> Term -> Identity Term)
-> ((Int -> Identity Int) -> (Int, Int) -> Identity (Int, Int))
-> (Int -> Identity Int)
-> Term
-> Identity Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Identity Int) -> (Int, Int) -> Identity (Int, Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2) ((Int -> Identity Int) -> Term -> Identity Term)
-> Int -> Term -> Term
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Int -> Int -> Int -> Int
limit Int
0 (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
numCols Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
col')) Term
term
      where
        col :: Int
col = Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2
        col' :: Int
col' = ((Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
tabspaces) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
tabspaces

processLF :: Term -> Term
processLF :: Term -> Term
processLF Term
term = Bool -> Term -> Term
addNewline (KeyboardState -> Bool
keyboardState_CRLF (Term
term Term -> Getting KeyboardState Term KeyboardState -> KeyboardState
forall s a. s -> Getting a s a -> a
^. Getting KeyboardState Term KeyboardState
Lens' Term KeyboardState
keyboardState)) Term
term

eraseInLine :: EraseInLineParam -> Term -> Term
eraseInLine :: EraseInLineParam -> Term -> Term
eraseInLine EraseInLineParam
ClearFromCursorToEndOfLine Term
term = (Int, Int) -> (Int, Int) -> Term -> Term
clearRegion (Term
term Term -> Getting (Int, Int) Term (Int, Int) -> (Int, Int)
forall s a. s -> Getting a s a -> a
^. Getting (Int, Int) Term (Int, Int)
Lens' Term (Int, Int)
cursorPos) (Term
term Term -> Getting (Int, Int) Term (Int, Int) -> (Int, Int)
forall s a. s -> Getting a s a -> a
^. Getting (Int, Int) Term (Int, Int)
Lens' Term (Int, Int)
cursorPos (Int, Int)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Int
forall s a. s -> Getting a s a -> a
^. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1, (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
numCols) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Term
term
eraseInLine EraseInLineParam
ClearFromCursorToBeginningOfLine Term
term = (Int, Int) -> (Int, Int) -> Term -> Term
clearRegion (Term
term Term -> Getting (Int, Int) Term (Int, Int) -> (Int, Int)
forall s a. s -> Getting a s a -> a
^. Getting (Int, Int) Term (Int, Int)
Lens' Term (Int, Int)
cursorPos (Int, Int)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Int
forall s a. s -> Getting a s a -> a
^. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1, Int
0) (Term
term Term -> Getting (Int, Int) Term (Int, Int) -> (Int, Int)
forall s a. s -> Getting a s a -> a
^. Getting (Int, Int) Term (Int, Int)
Lens' Term (Int, Int)
cursorPos) Term
term
eraseInLine EraseInLineParam
ClearEntireLine Term
term = (Int, Int) -> (Int, Int) -> Term -> Term
clearRegion (Term
term Term -> Getting (Int, Int) Term (Int, Int) -> (Int, Int)
forall s a. s -> Getting a s a -> a
^. Getting (Int, Int) Term (Int, Int)
Lens' Term (Int, Int)
cursorPos (Int, Int)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Int
forall s a. s -> Getting a s a -> a
^. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1, Int
0) (Term
term Term -> Getting (Int, Int) Term (Int, Int) -> (Int, Int)
forall s a. s -> Getting a s a -> a
^. Getting (Int, Int) Term (Int, Int)
Lens' Term (Int, Int)
cursorPos (Int, Int)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Int
forall s a. s -> Getting a s a -> a
^. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1, (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
numCols) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Term
term

eraseCharacters :: Int -> Term -> Term
eraseCharacters :: Int -> Term -> Term
eraseCharacters Int
n Term
term = (Int, Int) -> (Int, Int) -> Term -> Term
clearRegion (Term
term Term -> Getting (Int, Int) Term (Int, Int) -> (Int, Int)
forall s a. s -> Getting a s a -> a
^. Getting (Int, Int) Term (Int, Int)
Lens' Term (Int, Int)
cursorPos) (((Int -> Identity Int) -> (Int, Int) -> Identity (Int, Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((Int -> Identity Int) -> (Int, Int) -> Identity (Int, Int))
-> (Int -> Int) -> (Int, Int) -> (Int, Int)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1) (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n))) (Term
term Term -> Getting (Int, Int) Term (Int, Int) -> (Int, Int)
forall s a. s -> Getting a s a -> a
^. Getting (Int, Int) Term (Int, Int)
Lens' Term (Int, Int)
cursorPos)) Term
term

reverseIndex :: Term -> Term
reverseIndex :: Term -> Term
reverseIndex Term
term
  | Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
scrollTop = Int -> Int -> Term -> Term
scrollDown (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
scrollTop) Int
1 Term
term
  | Bool
otherwise = (Int, Int) -> Term -> Term
cursorMoveTo ((Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2) Term
term

eraseInDisplay :: EraseInDisplayParam -> Term -> Term
eraseInDisplay :: EraseInDisplayParam -> Term -> Term
eraseInDisplay EraseInDisplayParam
EraseAbove Term
_ = [Char] -> Term
forall a. HasCallStack => [Char] -> a
error [Char]
"TODO EraseAbove"
eraseInDisplay EraseInDisplayParam
EraseBelow Term
term = (Term -> Term
clearToEndOfLine (Term -> Term) -> (Term -> Term) -> Term -> Term
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Term -> Term
clearBelow) Term
term
  where
    clearToEndOfLine :: Term -> Term
clearToEndOfLine = (Int, Int) -> (Int, Int) -> Term -> Term
clearRegion (Term
term Term -> Getting (Int, Int) Term (Int, Int) -> (Int, Int)
forall s a. s -> Getting a s a -> a
^. Getting (Int, Int) Term (Int, Int)
Lens' Term (Int, Int)
cursorPos) (((Int -> Identity Int) -> (Int, Int) -> Identity (Int, Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((Int -> Identity Int) -> (Int, Int) -> Identity (Int, Int))
-> Int -> (Int, Int) -> (Int, Int)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ((Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
numCols) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) (Term
term Term -> Getting (Int, Int) Term (Int, Int) -> (Int, Int)
forall s a. s -> Getting a s a -> a
^. Getting (Int, Int) Term (Int, Int)
Lens' Term (Int, Int)
cursorPos))
    clearBelow :: Term -> Term
clearBelow
      | Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
numRows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 =
        (Int, Int) -> (Int, Int) -> Term -> Term
clearRegion
          ((((Int -> Identity Int) -> (Int, Int) -> Identity (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((Int -> Identity Int) -> (Int, Int) -> Identity (Int, Int))
-> (Int -> Int) -> (Int, Int) -> (Int, Int)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) ((Int, Int) -> (Int, Int))
-> ((Int, Int) -> (Int, Int)) -> (Int, Int) -> (Int, Int)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((Int -> Identity Int) -> (Int, Int) -> Identity (Int, Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((Int -> Identity Int) -> (Int, Int) -> Identity (Int, Int))
-> Int -> (Int, Int) -> (Int, Int)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
0)) (Term
term Term -> Getting (Int, Int) Term (Int, Int) -> (Int, Int)
forall s a. s -> Getting a s a -> a
^. Getting (Int, Int) Term (Int, Int)
Lens' Term (Int, Int)
cursorPos))
          ((((Int -> Identity Int) -> (Int, Int) -> Identity (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((Int -> Identity Int) -> (Int, Int) -> Identity (Int, Int))
-> Int -> (Int, Int) -> (Int, Int)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ((Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
numRows) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) ((Int, Int) -> (Int, Int))
-> ((Int, Int) -> (Int, Int)) -> (Int, Int) -> (Int, Int)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((Int -> Identity Int) -> (Int, Int) -> Identity (Int, Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((Int -> Identity Int) -> (Int, Int) -> Identity (Int, Int))
-> Int -> (Int, Int) -> (Int, Int)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ((Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
numCols) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))) (Term
term Term -> Getting (Int, Int) Term (Int, Int) -> (Int, Int)
forall s a. s -> Getting a s a -> a
^. Getting (Int, Int) Term (Int, Int)
Lens' Term (Int, Int)
cursorPos))
      | Bool
otherwise = Term -> Term
forall a. a -> a
id
eraseInDisplay EraseInDisplayParam
EraseAll Term
term = (Int, Int) -> (Int, Int) -> Term -> Term
clearRegion (Int
0, Int
0) ((Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
numRows) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
numCols) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Term
term
eraseInDisplay EraseInDisplayParam
EraseSavedLines Term
term = ((TermLines -> Identity TermLines) -> Term -> Identity Term
Lens' Term TermLines
scrollBackLines ((TermLines -> Identity TermLines) -> Term -> Identity Term)
-> TermLines -> Term -> Term
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TermLines
forall a. StrictSeq a
TL.empty) Term
term

windowManipulation :: WindowManipulation -> Term -> Term
windowManipulation :: WindowManipulation -> Term -> Term
windowManipulation WindowManipulation
SaveIconAndWindowTitleOnStack = Term -> Term
forall a. a -> a
id -- TODO We could add a stack to our 'Term' data structure and save this
windowManipulation WindowManipulation
RestoreIconAndWindowTitleOnStack = Term -> Term
forall a. a -> a
id -- TODO We could add a stack to our 'Term' data structure and save this

deviceStatusReport :: DeviceStatusReport -> Term -> (ByteString, Term)
deviceStatusReport :: DeviceStatusReport -> Term -> (ByteString, Term)
deviceStatusReport DeviceStatusReport
param Term
term = case DeviceStatusReport
param of
  DeviceStatusReport
StatusReport ->
    let ok :: ByteString
ok = ByteString
"\ESC[0n"
     in (ByteString
ok, Term
term)
  DeviceStatusReport
ReportCursorPosition ->
    let (Int
line, Int
col) = Term
term Term -> Getting (Int, Int) Term (Int, Int) -> (Int, Int)
forall s a. s -> Getting a s a -> a
^. Getting (Int, Int) Term (Int, Int)
Lens' Term (Int, Int)
cursorPos
        lineStr :: ByteString
lineStr = [Char] -> ByteString
BC8.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
        colStr :: ByteString
colStr = [Char] -> ByteString
BC8.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
        cpr :: ByteString
cpr = ByteString
"\ESC[" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
lineStr ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
";" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
colStr ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"R"
     in (ByteString
cpr, Term
term)

sendDeviceAttributes :: Term -> (ByteString, Term)
sendDeviceAttributes :: Term -> (ByteString, Term)
sendDeviceAttributes Term
term =
  let identification :: ByteString
identification = ByteString
"\ESC[?1;2c" -- TODO or maybe "\ESC[?6c" ?
   in (ByteString
identification, Term
term)

sendDeviceAttributesSecondary :: SendDeviceAttributesSecondary -> Term -> (ByteString, Term)
sendDeviceAttributesSecondary :: SendDeviceAttributesSecondary -> Term -> (ByteString, Term)
sendDeviceAttributesSecondary SendDeviceAttributesSecondary
RequestTerminalIdentificationCode Term
term =
  let identification :: ByteString
identification = ByteString
"\ESC[>0;0;0c"
   in (ByteString
identification, Term
term)

softTerminalReset :: Term -> Term
softTerminalReset :: Term -> Term
softTerminalReset Term
term = (Int, Int) -> Term
mkTerm (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
numCols, Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
numRows)

setMode :: Mode -> Term -> Term
setMode :: Mode -> Term -> Term
setMode Mode
KeyboardActionMode = (KeyboardState -> Identity KeyboardState) -> Term -> Identity Term
Lens' Term KeyboardState
keyboardState ((KeyboardState -> Identity KeyboardState)
 -> Term -> Identity Term)
-> (KeyboardState -> KeyboardState) -> Term -> Term
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (\KeyboardState
state -> KeyboardState
state {keyboardState_Locked :: Bool
keyboardState_Locked = Bool
True})
setMode Mode
InsertReplaceMode = (Bool -> Identity Bool) -> Term -> Identity Term
Lens' Term Bool
insertMode ((Bool -> Identity Bool) -> Term -> Identity Term)
-> Bool -> Term -> Term
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
setMode Mode
SendReceive = [Char] -> Term -> Term
forall a. HasCallStack => [Char] -> a
error [Char]
"TODO Send/receive (SRM) Not Supported"
setMode Mode
AutomaticNewlineNormalLinefeed = (KeyboardState -> Identity KeyboardState) -> Term -> Identity Term
Lens' Term KeyboardState
keyboardState ((KeyboardState -> Identity KeyboardState)
 -> Term -> Identity Term)
-> (KeyboardState -> KeyboardState) -> Term -> Term
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (\KeyboardState
state -> KeyboardState
state {keyboardState_CRLF :: Bool
keyboardState_CRLF = Bool
True})

resetMode :: Mode -> Term -> Term
resetMode :: Mode -> Term -> Term
resetMode Mode
KeyboardActionMode = (KeyboardState -> Identity KeyboardState) -> Term -> Identity Term
Lens' Term KeyboardState
keyboardState ((KeyboardState -> Identity KeyboardState)
 -> Term -> Identity Term)
-> (KeyboardState -> KeyboardState) -> Term -> Term
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (\KeyboardState
state -> KeyboardState
state {keyboardState_Locked :: Bool
keyboardState_Locked = Bool
False})
resetMode Mode
InsertReplaceMode = (Bool -> Identity Bool) -> Term -> Identity Term
Lens' Term Bool
insertMode ((Bool -> Identity Bool) -> Term -> Identity Term)
-> Bool -> Term -> Term
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
False
resetMode Mode
SendReceive = Term -> Term
forall a. a -> a
id
resetMode Mode
AutomaticNewlineNormalLinefeed = (KeyboardState -> Identity KeyboardState) -> Term -> Identity Term
Lens' Term KeyboardState
keyboardState ((KeyboardState -> Identity KeyboardState)
 -> Term -> Identity Term)
-> (KeyboardState -> KeyboardState) -> Term -> Term
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (\KeyboardState
state -> KeyboardState
state {keyboardState_CRLF :: Bool
keyboardState_CRLF = Bool
False})

processOsc :: OperatingSystemCommand -> Term -> (ByteString, Term)
processOsc :: OperatingSystemCommand -> Term -> (ByteString, Term)
processOsc (OSC_SetTitle Bool
_ Bool
True Text
str) = (Term -> Term) -> Term -> (ByteString, Term)
nw ((Term -> Term) -> Term -> (ByteString, Term))
-> (Term -> Term) -> Term -> (ByteString, Term)
forall a b. (a -> b) -> a -> b
$ (Text -> Identity Text) -> Term -> Identity Term
Lens' Term Text
windowTitle ((Text -> Identity Text) -> Term -> Identity Term)
-> Text -> Term -> Term
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
str
processOsc (OSC_SetTitle Bool
_ Bool
False Text
_) = (Term -> Term) -> Term -> (ByteString, Term)
nw Term -> Term
forall a. a -> a
id -- set window icon not supported
processOsc (OSC_ChangeTextForegroundColor Text
_) = (Term -> Term) -> Term -> (ByteString, Term)
nw Term -> Term
forall a. a -> a
id -- Ignore
processOsc (OSC_ChangeTextBackgroundColor Text
_) = (Term -> Term) -> Term -> (ByteString, Term)
nw Term -> Term
forall a. a -> a
id -- Ignore
processOsc OperatingSystemCommand
OSC_RequestTextForegroundColor = \Term
term -> (ByteString
"\ESC]10;0\a", Term
term)
processOsc OperatingSystemCommand
OSC_RequestTextBackgroundColor = \Term
term -> (ByteString
"\ESC]11;0\a", Term
term)
processOsc OperatingSystemCommand
OSC_ResetTextCursorColor = (Term -> Term) -> Term -> (ByteString, Term)
nw Term -> Term
forall a. a -> a
id

insertBlankChars :: Int -> Term -> Term
insertBlankChars :: Int -> Term -> Term
insertBlankChars Int
n Term
term = ((TermLine -> Identity TermLine) -> Term -> Identity Term
Lens' Term TermLine
cursorLine ((TermLine -> Identity TermLine) -> Term -> Identity Term)
-> (TermLine -> TermLine) -> Term -> Term
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ TermLine -> TermLine
updateLine) Term
term
  where
    n' :: Int
n' = Int -> Int -> Int -> Int
limit Int
0 (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
numCols Int -> Int -> Int
forall a. Num a => a -> a -> a
- Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2) Int
n
    col :: Int
col = Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2
    updateLine :: TermLine -> TermLine
    updateLine :: TermLine -> TermLine
updateLine TermLine
termLine =
      TermLine
start TermLine -> TermLine -> TermLine
forall a. Semigroup a => a -> a -> a
<> TermLine
blanks TermLine -> TermLine -> TermLine
forall a. Semigroup a => a -> a -> a
<> TermLine
rest
      where
        start :: TermLine
start = Int -> TermLine -> TermLine
forall a. Unbox a => Int -> Vector a -> Vector a
VU.take Int
col TermLine
termLine
        blanks :: TermLine
blanks = Int -> (Char, Attrs) -> TermLine
forall a. Unbox a => Int -> a -> Vector a
VU.replicate Int
n' (Char
' ', Term
term Term -> Getting Attrs Term Attrs -> Attrs
forall s a. s -> Getting a s a -> a
^. Getting Attrs Term Attrs
Lens' Term Attrs
termAttrs)
        rest :: TermLine
rest = Int -> Int -> TermLine -> TermLine
forall a. Unbox a => Int -> Int -> Vector a -> Vector a
VU.slice Int
col (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
numCols Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
col) TermLine
termLine

insertBlankLines :: Int -> Term -> Term
insertBlankLines :: Int -> Term -> Term
insertBlankLines Int
n Term
term
  | (Int, Int) -> Int -> Bool
forall a. Ord a => (a, a) -> a -> Bool
between (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
scrollTop, Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
scrollBottom) (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1) = Int -> Int -> Term -> Term
scrollDown (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1) Int
n Term
term
  | Bool
otherwise = Term
term

deleteChars :: Int -> Term -> Term
deleteChars :: Int -> Term -> Term
deleteChars Int
n Term
term = ((TermLine -> Identity TermLine) -> Term -> Identity Term
Lens' Term TermLine
cursorLine ((TermLine -> Identity TermLine) -> Term -> Identity Term)
-> (TermLine -> TermLine) -> Term -> Term
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ TermLine -> TermLine
updateLine) Term
term
  where
    n' :: Int
n' = Int -> Int -> Int -> Int
limit Int
0 ((Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
numCols) Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2)) Int
n
    srcCol :: Int
srcCol = Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n'
    size :: Int
size = Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
numCols Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
srcCol
    col :: Int
col = Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2
    updateLine :: TermLine -> TermLine
    updateLine :: TermLine -> TermLine
updateLine TermLine
termLine =
      TermLine
start TermLine -> TermLine -> TermLine
forall a. Semigroup a => a -> a -> a
<> TermLine
slice TermLine -> TermLine -> TermLine
forall a. Semigroup a => a -> a -> a
<> Int -> (Char, Attrs) -> TermLine
forall a. Unbox a => Int -> a -> Vector a
VU.replicate Int
n' (Char
' ', Term
term Term -> Getting Attrs Term Attrs -> Attrs
forall s a. s -> Getting a s a -> a
^. Getting Attrs Term Attrs
Lens' Term Attrs
termAttrs)
      where
        start :: TermLine
start = Int -> TermLine -> TermLine
forall a. Unbox a => Int -> Vector a -> Vector a
VU.take Int
col TermLine
termLine
        slice :: TermLine
slice = Int -> Int -> TermLine -> TermLine
forall a. Unbox a => Int -> Int -> Vector a -> Vector a
VU.slice Int
srcCol Int
size TermLine
termLine

deleteLines :: Int -> Term -> Term
deleteLines :: Int -> Term -> Term
deleteLines Int
n Term
term
  | (Int, Int) -> Int -> Bool
forall a. Ord a => (a, a) -> a -> Bool
between (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
scrollTop, Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
scrollBottom) (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1) = Int -> Int -> Term -> Term
scrollUp (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1) Int
n Term
term
  | Bool
otherwise = Term
term

setScrollingRegion :: Maybe Int -> Maybe Int -> Term -> Term
setScrollingRegion :: Maybe Int -> Maybe Int -> Term -> Term
setScrollingRegion Maybe Int
mbTop Maybe Int
mbBottom Term
term =
  (((Int -> Identity Int) -> Term -> Identity Term
Lens' Term Int
scrollTop ((Int -> Identity Int) -> Term -> Identity Term)
-> Int -> Term -> Term
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
top) (Term -> Term) -> (Term -> Term) -> Term -> Term
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((Int -> Identity Int) -> Term -> Identity Term
Lens' Term Int
scrollBottom ((Int -> Identity Int) -> Term -> Identity Term)
-> Int -> Term -> Term
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
bottom)) Term
term
  where
    top1 :: Int
top1 = case Maybe Int
mbTop of
      Maybe Int
Nothing -> Int
0
      Just Int
t -> Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    bottom1 :: Int
bottom1 = case Maybe Int
mbBottom of
      Maybe Int
Nothing -> Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
numRows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
      Just Int
b -> Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    minY :: Int
minY = Int
0
    maxY :: Int
maxY = Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
numRows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    top2 :: Int
top2 = Int -> Int -> Int -> Int
limit Int
minY Int
maxY Int
top1
    bottom2 :: Int
bottom2 = Int -> Int -> Int -> Int
limit Int
minY Int
maxY Int
bottom1
    (Int
top, Int
bottom) = if Int
top2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
bottom2 then (Int
bottom2, Int
top2) else (Int
top2, Int
bottom2)

termProcessDecset :: DECPrivateMode -> Term -> Term
termProcessDecset :: DECPrivateMode -> Term -> Term
termProcessDecset DECPrivateMode
DECPrivateMode.DECCKM = (KeyboardState -> Identity KeyboardState) -> Term -> Identity Term
Lens' Term KeyboardState
keyboardState ((KeyboardState -> Identity KeyboardState)
 -> Term -> Identity Term)
-> (KeyboardState -> KeyboardState) -> Term -> Term
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (\KeyboardState
state -> KeyboardState
state {keyboardState_DECCKM :: Bool
keyboardState_DECCKM = Bool
True})
termProcessDecset DECPrivateMode
DECPrivateMode.DECOM = ((CursorState -> Identity CursorState) -> Term -> Identity Term
Lens' Term CursorState
cursorState ((CursorState -> Identity CursorState) -> Term -> Identity Term)
-> ((Bool -> Identity Bool) -> CursorState -> Identity CursorState)
-> (Bool -> Identity Bool)
-> Term
-> Identity Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool) -> CursorState -> Identity CursorState
Lens' CursorState Bool
origin ((Bool -> Identity Bool) -> Term -> Identity Term)
-> Bool -> Term -> Term
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True) (Term -> Term) -> (Term -> Term) -> Term -> Term
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((Int, Int) -> Term -> Term
cursorMoveAbsoluteTo (Int
0, Int
0))
termProcessDecset DECPrivateMode
DECPrivateMode.ReportButtonPress = Term -> Term
forall a. a -> a
id
termProcessDecset DECPrivateMode
DECPrivateMode.BracketedPasteMode = Term -> Term
forall a. a -> a
id -- TODO Set flag on 'Term'
termProcessDecset DECPrivateMode
DECPrivateMode.SaveCursorAsInDECSCAndUseAlternateScreenBuffer = (Bool -> Identity Bool) -> Term -> Identity Term
Lens' Term Bool
altScreenActive ((Bool -> Identity Bool) -> Term -> Identity Term)
-> Bool -> Term -> Term
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
termProcessDecset DECPrivateMode
DECPrivateMode.Att610 = Term -> Term
forall a. a -> a
id -- TODO Set flag on 'Term'
termProcessDecset DECPrivateMode
DECPrivateMode.DECTCEM = Term -> Term
forall a. a -> a
id -- TODO Set flag on 'Term'
termProcessDecset DECPrivateMode
DECPrivateMode.DECAWM = (Bool -> Identity Bool) -> Term -> Identity Term
Lens' Term Bool
modeWrap ((Bool -> Identity Bool) -> Term -> Identity Term)
-> Bool -> Term -> Term
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
termProcessDecset DECPrivateMode
other = [Char] -> Term -> Term
forall a. HasCallStack => [Char] -> a
error ([Char] -> Term -> Term) -> [Char] -> Term -> Term
forall a b. (a -> b) -> a -> b
$ [Char]
"TODO: DECSET: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> DECPrivateMode -> [Char]
forall a. Show a => a -> [Char]
show DECPrivateMode
other

termProcessDecrst :: DECPrivateMode -> Term -> Term
termProcessDecrst :: DECPrivateMode -> Term -> Term
termProcessDecrst DECPrivateMode
DECPrivateMode.DECCKM = (KeyboardState -> Identity KeyboardState) -> Term -> Identity Term
Lens' Term KeyboardState
keyboardState ((KeyboardState -> Identity KeyboardState)
 -> Term -> Identity Term)
-> (KeyboardState -> KeyboardState) -> Term -> Term
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (\KeyboardState
state -> KeyboardState
state {keyboardState_DECCKM :: Bool
keyboardState_DECCKM = Bool
False})
termProcessDecrst DECPrivateMode
DECPrivateMode.DECOM = ((CursorState -> Identity CursorState) -> Term -> Identity Term
Lens' Term CursorState
cursorState ((CursorState -> Identity CursorState) -> Term -> Identity Term)
-> ((Bool -> Identity Bool) -> CursorState -> Identity CursorState)
-> (Bool -> Identity Bool)
-> Term
-> Identity Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool) -> CursorState -> Identity CursorState
Lens' CursorState Bool
origin ((Bool -> Identity Bool) -> Term -> Identity Term)
-> Bool -> Term -> Term
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
False) (Term -> Term) -> (Term -> Term) -> Term -> Term
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((Int, Int) -> Term -> Term
cursorMoveAbsoluteTo (Int
0, Int
0))
termProcessDecrst DECPrivateMode
DECPrivateMode.Att610 = Term -> Term
forall a. a -> a
id -- TODO Unset flag on 'Term'
termProcessDecrst DECPrivateMode
DECPrivateMode.DECTCEM = Term -> Term
forall a. a -> a
id -- TODO Unset flag on 'Term'
termProcessDecrst DECPrivateMode
DECPrivateMode.DECCOLM = Term -> Term
forall a. a -> a
id -- Ignored
termProcessDecrst DECPrivateMode
DECPrivateMode.ReportButtonPress = Term -> Term
forall a. a -> a
id
termProcessDecrst DECPrivateMode
DECPrivateMode.BracketedPasteMode = Term -> Term
forall a. a -> a
id -- TODO Unset flag on 'Term'
termProcessDecrst DECPrivateMode
DECPrivateMode.SaveCursorAsInDECSCAndUseAlternateScreenBuffer = (Bool -> Identity Bool) -> Term -> Identity Term
Lens' Term Bool
altScreenActive ((Bool -> Identity Bool) -> Term -> Identity Term)
-> Bool -> Term -> Term
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
False
termProcessDecrst DECPrivateMode
DECPrivateMode.DECAWM = (Bool -> Identity Bool) -> Term -> Identity Term
Lens' Term Bool
modeWrap ((Bool -> Identity Bool) -> Term -> Identity Term)
-> Bool -> Term -> Term
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
False
termProcessDecrst DECPrivateMode
DECPrivateMode.EnableAllMouseMotions = Term -> Term
forall a. a -> a
id
termProcessDecrst DECPrivateMode
DECPrivateMode.ReportMotionOnButtonPress = Term -> Term
forall a. a -> a
id
termProcessDecrst DECPrivateMode
other = [Char] -> Term -> Term
forall a. HasCallStack => [Char] -> a
error ([Char] -> Term -> Term) -> [Char] -> Term -> Term
forall a b. (a -> b) -> a -> b
$ [Char]
"TODO: DECRST: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> DECPrivateMode -> [Char]
forall a. Show a => a -> [Char]
show DECPrivateMode
other

termProcessSGR :: SGR.SGR -> Term -> Term
termProcessSGR :: SGR -> Term -> Term
termProcessSGR = ASetter Term Term Attrs Attrs -> (Attrs -> Attrs) -> Term -> Term
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Term Term Attrs Attrs
Lens' Term Attrs
termAttrs ((Attrs -> Attrs) -> Term -> Term)
-> (SGR -> Attrs -> Attrs) -> SGR -> Term -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SGR -> Attrs -> Attrs
applySGR

-- | For absolute user moves, when DECOM is set
cursorMoveAbsoluteTo :: (Int, Int) -> Term -> Term
cursorMoveAbsoluteTo :: (Int, Int) -> Term -> Term
cursorMoveAbsoluteTo (Int
row, Int
col) Term
term =
  (Int, Int) -> Term -> Term
cursorMoveTo (Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rowOffset, Int
col) Term
term
  where
    rowOffset :: Int
rowOffset
      | Term
term Term -> Getting Bool Term Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (CursorState -> Const Bool CursorState) -> Term -> Const Bool Term
Lens' Term CursorState
cursorState ((CursorState -> Const Bool CursorState)
 -> Term -> Const Bool Term)
-> ((Bool -> Const Bool Bool)
    -> CursorState -> Const Bool CursorState)
-> Getting Bool Term Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> CursorState -> Const Bool CursorState
Lens' CursorState Bool
origin = Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
scrollTop
      | Bool
otherwise = Int
0

cursorMoveTo :: (Int, Int) -> Term -> Term
cursorMoveTo :: (Int, Int) -> Term -> Term
cursorMoveTo (Int
row, Int
col) Term
term =
  ( ((Int, Int) -> Identity (Int, Int)) -> Term -> Identity Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Identity (Int, Int)) -> Term -> Identity Term)
-> ((Int -> Identity Int) -> (Int, Int) -> Identity (Int, Int))
-> (Int -> Identity Int)
-> Term
-> Identity Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Identity Int) -> (Int, Int) -> Identity (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((Int -> Identity Int) -> Term -> Identity Term)
-> Int -> Term -> Term
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Int -> Int -> Int -> Int
limit Int
minY Int
maxY Int
row)
      (Term -> Term) -> (Term -> Term) -> Term -> Term
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((Int, Int) -> Identity (Int, Int)) -> Term -> Identity Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Identity (Int, Int)) -> Term -> Identity Term)
-> ((Int -> Identity Int) -> (Int, Int) -> Identity (Int, Int))
-> (Int -> Identity Int)
-> Term
-> Identity Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Identity Int) -> (Int, Int) -> Identity (Int, Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((Int -> Identity Int) -> Term -> Identity Term)
-> Int -> Term -> Term
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Int -> Int -> Int -> Int
limit Int
minX Int
maxX Int
col)
      (Term -> Term) -> (Term -> Term) -> Term -> Term
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (CursorState -> Identity CursorState) -> Term -> Identity Term
Lens' Term CursorState
cursorState ((CursorState -> Identity CursorState) -> Term -> Identity Term)
-> ((Bool -> Identity Bool) -> CursorState -> Identity CursorState)
-> (Bool -> Identity Bool)
-> Term
-> Identity Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool) -> CursorState -> Identity CursorState
Lens' CursorState Bool
wrapNext ((Bool -> Identity Bool) -> Term -> Identity Term)
-> Bool -> Term -> Term
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
False
  )
    Term
term
  where
    minX :: Int
minX = Int
0
    maxX :: Int
maxX = Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
numCols Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    (Int
minY, Int
maxY)
      | Term
term Term -> Getting Bool Term Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (CursorState -> Const Bool CursorState) -> Term -> Const Bool Term
Lens' Term CursorState
cursorState ((CursorState -> Const Bool CursorState)
 -> Term -> Const Bool Term)
-> ((Bool -> Const Bool Bool)
    -> CursorState -> Const Bool CursorState)
-> Getting Bool Term Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> CursorState -> Const Bool CursorState
Lens' CursorState Bool
origin = (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
scrollTop, Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
scrollBottom)
      | Bool
otherwise = (Int
0, Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
numRows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

applySGR :: SGR.SGR -> Attrs -> Attrs
applySGR :: SGR -> Attrs -> Attrs
applySGR SGR
SGR.Reset = Attrs -> Attrs -> Attrs
forall a b. a -> b -> a
const Attrs
blankAttrs
applySGR (SGR.SetConsoleIntensity ConsoleIntensity
intensity) = ASetter Attrs Attrs ConsoleIntensity ConsoleIntensity
-> ConsoleIntensity -> Attrs -> Attrs
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Attrs Attrs ConsoleIntensity ConsoleIntensity
Lens' Attrs ConsoleIntensity
attrsIntensity ConsoleIntensity
intensity
applySGR (SGR.SetItalicized Bool
_) = Attrs -> Attrs
forall a. a -> a
id -- TODO Not Supported
applySGR (SGR.SetUnderlining Underlining
underlining) = ASetter Attrs Attrs Underlining Underlining
-> Underlining -> Attrs -> Attrs
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Attrs Attrs Underlining Underlining
Lens' Attrs Underlining
attrsUnderline Underlining
underlining
applySGR (SGR.SetBlinkSpeed BlinkSpeed
_) = Attrs -> Attrs
forall a. a -> a
id -- TODO Not Supported
applySGR (SGR.SetVisible Bool
_) = Attrs -> Attrs
forall a. a -> a
id -- TODO Not Supported
applySGR (SGR.SetSwapForegroundBackground Bool
_) = Attrs -> Attrs
forall a. a -> a
id -- TODO Not Supported
applySGR (SGR.SetColor ConsoleLayer
SGR.Foreground ColorIntensity
intensity Color
color) = ASetter
  Attrs
  Attrs
  (Maybe (ColorIntensity, Color))
  (Maybe (ColorIntensity, Color))
-> Maybe (ColorIntensity, Color) -> Attrs -> Attrs
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  Attrs
  Attrs
  (Maybe (ColorIntensity, Color))
  (Maybe (ColorIntensity, Color))
Lens' Attrs (Maybe (ColorIntensity, Color))
attrsFg ((ColorIntensity, Color) -> Maybe (ColorIntensity, Color)
forall a. a -> Maybe a
Just (ColorIntensity
intensity, Color
color))
applySGR (SGR.SetColor ConsoleLayer
SGR.Background ColorIntensity
intensity Color
color) = ASetter
  Attrs
  Attrs
  (Maybe (ColorIntensity, Color))
  (Maybe (ColorIntensity, Color))
-> Maybe (ColorIntensity, Color) -> Attrs -> Attrs
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  Attrs
  Attrs
  (Maybe (ColorIntensity, Color))
  (Maybe (ColorIntensity, Color))
Lens' Attrs (Maybe (ColorIntensity, Color))
attrsBg ((ColorIntensity, Color) -> Maybe (ColorIntensity, Color)
forall a. a -> Maybe a
Just (ColorIntensity
intensity, Color
color))
applySGR (SGR.SetRGBColor ConsoleLayer
_ Colour Float
_) = Attrs -> Attrs
forall a. a -> a
id -- TODO Not Supported
applySGR (SGR.SetPaletteColor ConsoleLayer
_ Word8
_) = Attrs -> Attrs
forall a. a -> a
id -- TODO Not Supported
applySGR (SGR.SetDefaultColor ConsoleLayer
SGR.Foreground) = ASetter
  Attrs
  Attrs
  (Maybe (ColorIntensity, Color))
  (Maybe (ColorIntensity, Color))
-> Maybe (ColorIntensity, Color) -> Attrs -> Attrs
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  Attrs
  Attrs
  (Maybe (ColorIntensity, Color))
  (Maybe (ColorIntensity, Color))
Lens' Attrs (Maybe (ColorIntensity, Color))
attrsFg Maybe (ColorIntensity, Color)
forall a. Maybe a
Nothing
applySGR (SGR.SetDefaultColor ConsoleLayer
SGR.Background) = ASetter
  Attrs
  Attrs
  (Maybe (ColorIntensity, Color))
  (Maybe (ColorIntensity, Color))
-> Maybe (ColorIntensity, Color) -> Attrs -> Attrs
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  Attrs
  Attrs
  (Maybe (ColorIntensity, Color))
  (Maybe (ColorIntensity, Color))
Lens' Attrs (Maybe (ColorIntensity, Color))
attrsBg Maybe (ColorIntensity, Color)
forall a. Maybe a
Nothing

processVisibleChar :: Char -> Term -> Term
processVisibleChar :: Char -> Term -> Term
processVisibleChar Char
c =
  Term -> Term
moveCursorBefore
    (Term -> Term) -> (Term -> Term) -> Term -> Term
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Term -> Term
moveChars
    (Term -> Term) -> (Term -> Term) -> Term -> Term
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Term -> Term
moveCursorDown
    (Term -> Term) -> (Term -> Term) -> Term -> Term
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Term -> Term
setChar
    (Term -> Term) -> (Term -> Term) -> Term -> Term
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Term -> Term
moveCursorAfter
  where
    moveCursorBefore :: Term -> Term
    moveCursorBefore :: Term -> Term
moveCursorBefore Term
term
      | (Term
term Term -> Getting Bool Term Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool Term Bool
Lens' Term Bool
modeWrap) Bool -> Bool -> Bool
&& (Term
term Term -> Getting CursorState Term CursorState -> CursorState
forall s a. s -> Getting a s a -> a
^. Getting CursorState Term CursorState
Lens' Term CursorState
cursorState CursorState
-> ((Bool -> Const Bool Bool)
    -> CursorState -> Const Bool CursorState)
-> Bool
forall s a. s -> Getting a s a -> a
^. (Bool -> Const Bool Bool) -> CursorState -> Const Bool CursorState
Lens' CursorState Bool
wrapNext) = Bool -> Term -> Term
addNewline Bool
True Term
term
      | Bool
otherwise = Term
term
    moveChars :: Term -> Term
    moveChars :: Term -> Term
moveChars Term
term
      | (Term
term Term -> Getting Bool Term Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool Term Bool
Lens' Term Bool
insertMode) Bool -> Bool -> Bool
&& (Int
col Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
numCols) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) =
        ( (TermLine -> Identity TermLine) -> Term -> Identity Term
Lens' Term TermLine
cursorLine
            ((TermLine -> Identity TermLine) -> Term -> Identity Term)
-> (TermLine -> TermLine) -> Term -> Term
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ( \TermLine
line ->
                   Int -> TermLine -> TermLine
forall a. Unbox a => Int -> Vector a -> Vector a
VU.take
                     (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
numCols)
                     (Int -> TermLine -> TermLine
forall a. Unbox a => Int -> Vector a -> Vector a
VU.take Int
col TermLine
line TermLine -> TermLine -> TermLine
forall a. Semigroup a => a -> a -> a
<> (Char, Attrs) -> TermLine
forall a. Unbox a => a -> Vector a
VU.singleton (Char
' ', Attrs
0) TermLine -> TermLine -> TermLine
forall a. Semigroup a => a -> a -> a
<> Int -> TermLine -> TermLine
forall a. Unbox a => Int -> Vector a -> Vector a
VU.drop Int
col TermLine
line)
               )
        )
          Term
term
      | Bool
otherwise = Term
term
      where
        col :: Int
col = Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2
    moveCursorDown :: Term -> Term
    moveCursorDown :: Term -> Term
moveCursorDown Term
term
      | Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
numCols) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 = Bool -> Term -> Term
addNewline Bool
True Term
term
      | Bool
otherwise = Term
term
    setChar :: Term -> Term
    setChar :: Term -> Term
setChar Term
term = (((TermLine -> Identity TermLine) -> Term -> Identity Term
Lens' Term TermLine
cursorLine ((TermLine -> Identity TermLine) -> Term -> Identity Term)
-> (((Char, Attrs) -> Identity (Char, Attrs))
    -> TermLine -> Identity TermLine)
-> ((Char, Attrs) -> Identity (Char, Attrs))
-> Term
-> Identity Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Lens' TermLine (Char, Attrs)
forall a. Unbox a => Int -> Lens' (Vector a) a
vuIndex (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2))) (((Char, Attrs) -> Identity (Char, Attrs))
 -> Term -> Identity Term)
-> (Char, Attrs) -> Term -> Term
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Char
c, Term
term Term -> Getting Attrs Term Attrs -> Attrs
forall s a. s -> Getting a s a -> a
^. Getting Attrs Term Attrs
Lens' Term Attrs
termAttrs)) Term
term
    moveCursorAfter :: Term -> Term
    moveCursorAfter :: Term -> Term
moveCursorAfter Term
term
      | Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
numCols) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 = (Int, Int) -> Term -> Term
cursorMoveTo (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1, (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Term
term
      | Bool
otherwise = (((CursorState -> Identity CursorState) -> Term -> Identity Term
Lens' Term CursorState
cursorState ((CursorState -> Identity CursorState) -> Term -> Identity Term)
-> ((Bool -> Identity Bool) -> CursorState -> Identity CursorState)
-> (Bool -> Identity Bool)
-> Term
-> Identity Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool) -> CursorState -> Identity CursorState
Lens' CursorState Bool
wrapNext) ((Bool -> Identity Bool) -> Term -> Identity Term)
-> Bool -> Term -> Term
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True) Term
term

addNewline ::
  -- | first column
  Bool ->
  Term ->
  Term
addNewline :: Bool -> Term -> Term
addNewline Bool
firstCol = Term -> Term
doScrollUp (Term -> Term) -> (Term -> Term) -> Term -> Term
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Term -> Term
moveCursor
  where
    doScrollUp :: Term -> Term
    doScrollUp :: Term -> Term
doScrollUp Term
term
      | Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
scrollBottom = Int -> Int -> Term -> Term
scrollUp (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
scrollTop) Int
1 Term
term
      | Bool
otherwise = Term
term
    moveCursor :: Term -> Term
    moveCursor :: Term -> Term
moveCursor Term
term = (Int, Int) -> Term -> Term
cursorMoveTo (Int
newRow, Int
newCol) Term
term
      where
        newRow :: Int
newRow
          | Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
scrollBottom = Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1
          | Bool
otherwise = (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field1 s t a b => Lens s t a b
_1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        newCol :: Int
newCol
          | Bool
firstCol = Int
0
          | Bool
otherwise = Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. ((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term
Lens' Term (Int, Int)
cursorPos (((Int, Int) -> Const Int (Int, Int)) -> Term -> Const Int Term)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Term Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2

scrollDown :: Int -> Int -> Term -> Term
scrollDown :: Int -> Int -> Term -> Term
scrollDown Int
orig Int
n Term
term = Term -> Term
scrollLines Term
term
  where
    n' :: Int
n' = Int -> Int -> Int -> Int
limit Int
0 (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
scrollBottom Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
orig Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
n
    scrollLines :: Term -> Term
scrollLines =
      (TermLines -> Identity TermLines) -> Term -> Identity Term
Lens' Term TermLines
activeScreen
        ((TermLines -> Identity TermLines) -> Term -> Identity Term)
-> (TermLines -> TermLines) -> Term -> Term
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ( \TermLines
lines ->
               Int -> TermLines -> TermLines
forall a. Int -> StrictSeq a -> StrictSeq a
TL.take Int
orig TermLines
lines
                 TermLines -> TermLines -> TermLines
forall a. Semigroup a => a -> a -> a
<> Int -> TermLine -> TermLines
forall a. Int -> a -> StrictSeq a
TL.replicate Int
n' TermLine
newBlankLine
                 TermLines -> TermLines -> TermLines
forall a. Semigroup a => a -> a -> a
<> Int -> TermLines -> TermLines
forall a. Int -> StrictSeq a -> StrictSeq a
TL.take ((Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
scrollBottom) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
orig Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> TermLines -> TermLines
forall a. Int -> StrictSeq a -> StrictSeq a
TL.drop Int
orig TermLines
lines)
                 TermLines -> TermLines -> TermLines
forall a. Semigroup a => a -> a -> a
<> Int -> TermLines -> TermLines
forall a. Int -> StrictSeq a -> StrictSeq a
TL.drop ((Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
scrollBottom) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) TermLines
lines
           )
    newBlankLine :: TermLine
newBlankLine = Int -> (Char, Attrs) -> TermLine
forall a. Unbox a => Int -> a -> Vector a
VU.replicate (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
numCols) (Char
' ', Term
term Term -> Getting Attrs Term Attrs -> Attrs
forall s a. s -> Getting a s a -> a
^. Getting Attrs Term Attrs
Lens' Term Attrs
termAttrs)

scrollUp :: Int -> Int -> Term -> Term
scrollUp :: Int -> Int -> Term -> Term
scrollUp Int
orig Int
n Term
term =
  (Term -> Term
copyLinesToScrollBack (Term -> Term) -> (Term -> Term) -> Term -> Term
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Term -> Term
scrollLines) Term
term
  where
    n' :: Int
n' = Int -> Int -> Int -> Int
limit Int
0 (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
scrollBottom Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
orig Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
n
    copyLinesToScrollBack :: Term -> Term
copyLinesToScrollBack
      | Bool -> Bool
not (Term
term Term -> Getting Bool Term Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool Term Bool
Lens' Term Bool
altScreenActive) Bool -> Bool -> Bool
&& Int
orig Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = TermLines -> Term -> Term
addScrollBackLines (Int -> TermLines -> TermLines
forall a. Int -> StrictSeq a -> StrictSeq a
TL.take Int
n' (Term
term Term -> Getting TermLines Term TermLines -> TermLines
forall s a. s -> Getting a s a -> a
^. Getting TermLines Term TermLines
Lens' Term TermLines
termScreen))
      | Bool
otherwise = Term -> Term
forall a. a -> a
id
    scrollLines :: Term -> Term
scrollLines =
      (TermLines -> Identity TermLines) -> Term -> Identity Term
Lens' Term TermLines
activeScreen
        ((TermLines -> Identity TermLines) -> Term -> Identity Term)
-> (TermLines -> TermLines) -> Term -> Term
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ( \TermLines
lines ->
               Int -> TermLines -> TermLines
forall a. Int -> StrictSeq a -> StrictSeq a
TL.take Int
orig TermLines
lines
                 TermLines -> TermLines -> TermLines
forall a. Semigroup a => a -> a -> a
<> Int -> TermLines -> TermLines
forall a. Int -> StrictSeq a -> StrictSeq a
TL.take ((Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
scrollBottom) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
orig Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> TermLines -> TermLines
forall a. Int -> StrictSeq a -> StrictSeq a
TL.drop (Int
orig Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n') TermLines
lines)
                 TermLines -> TermLines -> TermLines
forall a. Semigroup a => a -> a -> a
<> Int -> TermLine -> TermLines
forall a. Int -> a -> StrictSeq a
TL.replicate Int
n' TermLine
newBlankLine
                 TermLines -> TermLines -> TermLines
forall a. Semigroup a => a -> a -> a
<> Int -> TermLines -> TermLines
forall a. Int -> StrictSeq a -> StrictSeq a
TL.drop ((Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
scrollBottom) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) TermLines
lines
           )
    newBlankLine :: TermLine
newBlankLine = Int -> (Char, Attrs) -> TermLine
forall a. Unbox a => Int -> a -> Vector a
VU.replicate (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
numCols) (Char
' ', Term
term Term -> Getting Attrs Term Attrs -> Attrs
forall s a. s -> Getting a s a -> a
^. Getting Attrs Term Attrs
Lens' Term Attrs
termAttrs)

clearRegion :: (Int, Int) -> (Int, Int) -> Term -> Term
clearRegion :: (Int, Int) -> (Int, Int) -> Term -> Term
clearRegion (Int
line1, Int
col1) (Int
line2, Int
col2) Term
term =
  (Term -> Int -> Term) -> Term -> [Int] -> Term
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
    (\Term
t Int
line -> Int -> Int -> Int -> Term -> Term
clearRow Int
line (Int -> Int -> Int -> Int
limit Int
minX Int
maxX Int
col1') (Int -> Int -> Int -> Int
limit Int
minX Int
maxX Int
col2') Term
t)
    Term
term
    [(Int -> Int -> Int -> Int
limit Int
minY Int
maxY Int
line1') .. (Int -> Int -> Int -> Int
limit Int
minY Int
maxY Int
line2')]
  where
    line1' :: Int
line1' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
line1 Int
line2
    line2' :: Int
line2' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
line1 Int
line2
    col1' :: Int
col1' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
col1 Int
col2
    col2' :: Int
col2' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
col1 Int
col2
    minX :: Int
minX = Int
0
    maxX :: Int
maxX = Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
numCols Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    minY :: Int
minY = Int
0
    maxY :: Int
maxY = Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
numRows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

clearRow :: Int -> Int -> Int -> Term -> Term
clearRow :: Int -> Int -> Int -> Term -> Term
clearRow Int
line Int
startCol Int
endCol Term
term =
  (Term -> Int -> Term) -> Term -> [Int] -> Term
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
    (\Term
t Int
col -> ((TermLines -> Identity TermLines) -> Term -> Identity Term
Lens' Term TermLines
activeScreen ((TermLines -> Identity TermLines) -> Term -> Identity Term)
-> (((Char, Attrs) -> Identity (Char, Attrs))
    -> TermLines -> Identity TermLines)
-> ((Char, Attrs) -> Identity (Char, Attrs))
-> Term
-> Identity Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Lens' TermLines TermLine
forall a. Int -> Lens' (StrictSeq a) a
TL.vIndex Int
line ((TermLine -> Identity TermLine)
 -> TermLines -> Identity TermLines)
-> (((Char, Attrs) -> Identity (Char, Attrs))
    -> TermLine -> Identity TermLine)
-> ((Char, Attrs) -> Identity (Char, Attrs))
-> TermLines
-> Identity TermLines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Lens' TermLine (Char, Attrs)
forall a. Unbox a => Int -> Lens' (Vector a) a
vuIndex Int
col (((Char, Attrs) -> Identity (Char, Attrs))
 -> Term -> Identity Term)
-> (Char, Attrs) -> Term -> Term
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Char
' ', Attrs
attrs)) Term
t)
    Term
term
    [Int
startCol .. Int
endCol]
  where
    attrs :: Attrs
attrs = Term
term Term -> Getting Attrs Term Attrs -> Attrs
forall s a. s -> Getting a s a -> a
^. Getting Attrs Term Attrs
Lens' Term Attrs
termAttrs

limit ::
  -- | minimum allowed value
  Int ->
  -- | maximum allowed value
  Int ->
  -- | value to limit
  Int ->
  Int
limit :: Int -> Int -> Int -> Int
limit Int
minVal Int
maxVal Int
val
  | Int
val Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
minVal = Int
minVal
  | Int
val Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxVal = Int
maxVal
  | Bool
otherwise = Int
val

between :: Ord a => (a, a) -> a -> Bool
between :: (a, a) -> a -> Bool
between (a
low, a
high) a
val = a
val a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
low Bool -> Bool -> Bool
&& a
val a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
high