{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}

module System.Terminal.Emulator.Term
  ( -- * Types
    Term,
    mkTerm,

    -- * Direct 'Term' Lenses
    termAttrs,
    cursorPos,
    cursorState,
    modeWrap,
    insertMode,
    altScreenActive,
    numCols,
    numRows,
    keyboardState,
    scrollTop,
    scrollBottom,
    scrollBackLines,
    numScrollBackLines,
    termScreen,
    termAlt,
    windowTitle,

    -- * Direct 'CursorState' Lenses
    wrapNext,
    origin,

    -- * Helper 'Term' Lenses
    cursorLine,
    activeScreen,

    -- * Misc
    addScrollBackLines,
    vuIndex,
    termGetKeyboardState,
  )
where

import Control.Category ((>>>))
import Control.Exception (assert)
import Control.Lens
import Data.Text (Text)
import qualified Data.Vector.Unboxed as VU
import System.Terminal.Emulator.Attrs (Attrs, blankAttrs)
import System.Terminal.Emulator.KeyboardInput (KeyboardState, initialKeyboardState)
import System.Terminal.Emulator.TermLines (TermLine, TermLines)
import qualified System.Terminal.Emulator.TermLines as TL
import Prelude hiding (lines)

data CursorState = CursorState
  { CursorState -> Bool
cursorState_WrapNext :: !Bool,
    CursorState -> Bool
cursorState_Origin :: !Bool
  }
  deriving (Int -> CursorState -> ShowS
[CursorState] -> ShowS
CursorState -> String
(Int -> CursorState -> ShowS)
-> (CursorState -> String)
-> ([CursorState] -> ShowS)
-> Show CursorState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CursorState] -> ShowS
$cshowList :: [CursorState] -> ShowS
show :: CursorState -> String
$cshow :: CursorState -> String
showsPrec :: Int -> CursorState -> ShowS
$cshowsPrec :: Int -> CursorState -> ShowS
Show, CursorState -> CursorState -> Bool
(CursorState -> CursorState -> Bool)
-> (CursorState -> CursorState -> Bool) -> Eq CursorState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CursorState -> CursorState -> Bool
$c/= :: CursorState -> CursorState -> Bool
== :: CursorState -> CursorState -> Bool
$c== :: CursorState -> CursorState -> Bool
Eq, Eq CursorState
Eq CursorState
-> (CursorState -> CursorState -> Ordering)
-> (CursorState -> CursorState -> Bool)
-> (CursorState -> CursorState -> Bool)
-> (CursorState -> CursorState -> Bool)
-> (CursorState -> CursorState -> Bool)
-> (CursorState -> CursorState -> CursorState)
-> (CursorState -> CursorState -> CursorState)
-> Ord CursorState
CursorState -> CursorState -> Bool
CursorState -> CursorState -> Ordering
CursorState -> CursorState -> CursorState
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CursorState -> CursorState -> CursorState
$cmin :: CursorState -> CursorState -> CursorState
max :: CursorState -> CursorState -> CursorState
$cmax :: CursorState -> CursorState -> CursorState
>= :: CursorState -> CursorState -> Bool
$c>= :: CursorState -> CursorState -> Bool
> :: CursorState -> CursorState -> Bool
$c> :: CursorState -> CursorState -> Bool
<= :: CursorState -> CursorState -> Bool
$c<= :: CursorState -> CursorState -> Bool
< :: CursorState -> CursorState -> Bool
$c< :: CursorState -> CursorState -> Bool
compare :: CursorState -> CursorState -> Ordering
$ccompare :: CursorState -> CursorState -> Ordering
$cp1Ord :: Eq CursorState
Ord)

data CursorPos = CursorPos !Int !Int
  deriving (Int -> CursorPos -> ShowS
[CursorPos] -> ShowS
CursorPos -> String
(Int -> CursorPos -> ShowS)
-> (CursorPos -> String)
-> ([CursorPos] -> ShowS)
-> Show CursorPos
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CursorPos] -> ShowS
$cshowList :: [CursorPos] -> ShowS
show :: CursorPos -> String
$cshow :: CursorPos -> String
showsPrec :: Int -> CursorPos -> ShowS
$cshowsPrec :: Int -> CursorPos -> ShowS
Show, CursorPos -> CursorPos -> Bool
(CursorPos -> CursorPos -> Bool)
-> (CursorPos -> CursorPos -> Bool) -> Eq CursorPos
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CursorPos -> CursorPos -> Bool
$c/= :: CursorPos -> CursorPos -> Bool
== :: CursorPos -> CursorPos -> Bool
$c== :: CursorPos -> CursorPos -> Bool
Eq, Eq CursorPos
Eq CursorPos
-> (CursorPos -> CursorPos -> Ordering)
-> (CursorPos -> CursorPos -> Bool)
-> (CursorPos -> CursorPos -> Bool)
-> (CursorPos -> CursorPos -> Bool)
-> (CursorPos -> CursorPos -> Bool)
-> (CursorPos -> CursorPos -> CursorPos)
-> (CursorPos -> CursorPos -> CursorPos)
-> Ord CursorPos
CursorPos -> CursorPos -> Bool
CursorPos -> CursorPos -> Ordering
CursorPos -> CursorPos -> CursorPos
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CursorPos -> CursorPos -> CursorPos
$cmin :: CursorPos -> CursorPos -> CursorPos
max :: CursorPos -> CursorPos -> CursorPos
$cmax :: CursorPos -> CursorPos -> CursorPos
>= :: CursorPos -> CursorPos -> Bool
$c>= :: CursorPos -> CursorPos -> Bool
> :: CursorPos -> CursorPos -> Bool
$c> :: CursorPos -> CursorPos -> Bool
<= :: CursorPos -> CursorPos -> Bool
$c<= :: CursorPos -> CursorPos -> Bool
< :: CursorPos -> CursorPos -> Bool
$c< :: CursorPos -> CursorPos -> Bool
compare :: CursorPos -> CursorPos -> Ordering
$ccompare :: CursorPos -> CursorPos -> Ordering
$cp1Ord :: Eq CursorPos
Ord)

data Term = Term
  { Term -> Attrs
term_Attrs :: !Attrs,
    -- | (line, column)
    Term -> CursorPos
term_CursorPos :: !CursorPos,
    Term -> CursorState
term_CursorState :: !CursorState,
    -- | Set using Wraparound Mode (DECAWM)
    Term -> Bool
term_ModeWrap :: !Bool,
    -- | Set using Insert/Replace Mode (IRM)
    Term -> Bool
term_InsertMode :: !Bool,
    Term -> Bool
term_AltScreenActive :: !Bool,
    Term -> Int
term_NumCols :: !Int,
    Term -> Int
term_NumRows :: !Int,
    Term -> KeyboardState
term_KeyboardState :: !KeyboardState,
    -- | Row index of the top of the scroll region
    Term -> Int
term_ScrollTop :: !Int,
    -- | Row index of the bottom of the scroll region
    Term -> Int
term_ScrollBottom :: !Int,
    -- | Scroll back lines of the Main screen
    Term -> TermLines
term_ScrollBackLines :: !TermLines,
    -- | Maximum scroll back lines to be saved
    Term -> Int
term_NumScrollBackLines :: !Int,
    -- | Main screen. This is always the size of the terminal.
    Term -> TermLines
term_Screen :: !TermLines,
    -- | Alternate screen. This is always the size of the terminal.
    --
    -- The Alternate screen does not have any scroll back lines
    --
    -- See also:
    -- <https://invisible-island.net/xterm/ctlseqs/ctlseqs.html#h2-The-Alternate-Screen-Buffer>
    Term -> TermLines
term_Alt :: !TermLines,
    Term -> Text
term_WindowTitle :: !Text
  }
  deriving (Int -> Term -> ShowS
[Term] -> ShowS
Term -> String
(Int -> Term -> ShowS)
-> (Term -> String) -> ([Term] -> ShowS) -> Show Term
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Term] -> ShowS
$cshowList :: [Term] -> ShowS
show :: Term -> String
$cshow :: Term -> String
showsPrec :: Int -> Term -> ShowS
$cshowsPrec :: Int -> Term -> ShowS
Show, Term -> Term -> Bool
(Term -> Term -> Bool) -> (Term -> Term -> Bool) -> Eq Term
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Term -> Term -> Bool
$c/= :: Term -> Term -> Bool
== :: Term -> Term -> Bool
$c== :: Term -> Term -> Bool
Eq, Eq Term
Eq Term
-> (Term -> Term -> Ordering)
-> (Term -> Term -> Bool)
-> (Term -> Term -> Bool)
-> (Term -> Term -> Bool)
-> (Term -> Term -> Bool)
-> (Term -> Term -> Term)
-> (Term -> Term -> Term)
-> Ord Term
Term -> Term -> Bool
Term -> Term -> Ordering
Term -> Term -> Term
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Term -> Term -> Term
$cmin :: Term -> Term -> Term
max :: Term -> Term -> Term
$cmax :: Term -> Term -> Term
>= :: Term -> Term -> Bool
$c>= :: Term -> Term -> Bool
> :: Term -> Term -> Bool
$c> :: Term -> Term -> Bool
<= :: Term -> Term -> Bool
$c<= :: Term -> Term -> Bool
< :: Term -> Term -> Bool
$c< :: Term -> Term -> Bool
compare :: Term -> Term -> Ordering
$ccompare :: Term -> Term -> Ordering
$cp1Ord :: Eq Term
Ord)

-- | Create a new blank Terminal with the given size @(width, height)@
mkTerm :: (Int, Int) -> Term
mkTerm :: (Int, Int) -> Term
mkTerm (Int
width, Int
height) =
  Term :: Attrs
-> CursorPos
-> CursorState
-> Bool
-> Bool
-> Bool
-> Int
-> Int
-> KeyboardState
-> Int
-> Int
-> TermLines
-> Int
-> TermLines
-> TermLines
-> Text
-> Term
Term
    { term_Attrs :: Attrs
term_Attrs = Attrs
blankAttrs,
      term_CursorPos :: CursorPos
term_CursorPos = Int -> Int -> CursorPos
CursorPos Int
0 Int
0,
      term_CursorState :: CursorState
term_CursorState =
        CursorState :: Bool -> Bool -> CursorState
CursorState
          { cursorState_WrapNext :: Bool
cursorState_WrapNext = Bool
False,
            cursorState_Origin :: Bool
cursorState_Origin = Bool
False
          },
      term_ModeWrap :: Bool
term_ModeWrap = Bool
True,
      term_InsertMode :: Bool
term_InsertMode = Bool
False,
      term_AltScreenActive :: Bool
term_AltScreenActive = Bool
False,
      term_NumCols :: Int
term_NumCols = Int
width,
      term_NumRows :: Int
term_NumRows = Int
height,
      term_KeyboardState :: KeyboardState
term_KeyboardState = KeyboardState
initialKeyboardState,
      term_ScrollTop :: Int
term_ScrollTop = Int
0,
      term_ScrollBottom :: Int
term_ScrollBottom = Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1,
      term_ScrollBackLines :: TermLines
term_ScrollBackLines = TermLines
forall a. StrictSeq a
TL.empty,
      term_NumScrollBackLines :: Int
term_NumScrollBackLines = Int
1000,
      term_Screen :: TermLines
term_Screen = Int -> Vector (Char, Attrs) -> TermLines
forall a. Int -> a -> StrictSeq a
TL.replicate Int
height (Int -> (Char, Attrs) -> Vector (Char, Attrs)
forall a. Unbox a => Int -> a -> Vector a
VU.replicate Int
width ((Char
' ', Attrs
0))),
      term_Alt :: TermLines
term_Alt = Int -> Vector (Char, Attrs) -> TermLines
forall a. Int -> a -> StrictSeq a
TL.replicate Int
height (Int -> (Char, Attrs) -> Vector (Char, Attrs)
forall a. Unbox a => Int -> a -> Vector a
VU.replicate Int
width ((Char
' ', Attrs
0))),
      term_WindowTitle :: Text
term_WindowTitle = Text
"hs-term"
    }

-----------------------------------------------------------------------
-- Direct 'Term' Lenses
-----------------------------------------------------------------------

termAttrs :: Lens' Term Attrs
termAttrs :: (Attrs -> f Attrs) -> Term -> f Term
termAttrs = (Term -> Attrs)
-> (Term -> Attrs -> Term) -> Lens Term Term Attrs Attrs
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Term -> Attrs
term_Attrs (\Term
term Attrs
newVal -> Term
term {term_Attrs :: Attrs
term_Attrs = Attrs
newVal})

-- | Cursor line is always in the range [0..numRows-1]
--
-- Cursor col is always in the range [0..numCols-1]
cursorPos :: Lens' Term (Int, Int)
cursorPos :: ((Int, Int) -> f (Int, Int)) -> Term -> f Term
cursorPos = (Term -> (Int, Int))
-> (Term -> (Int, Int) -> Term)
-> Lens Term Term (Int, Int) (Int, Int)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Term -> (Int, Int)
getter Term -> (Int, Int) -> Term
setter
  where
    getter :: Term -> (Int, Int)
    getter :: Term -> (Int, Int)
getter Term
term = let CursorPos Int
row Int
col = Term -> CursorPos
term_CursorPos Term
term in (Int
row, Int
col)
    setter :: Term -> (Int, Int) -> Term
    setter :: Term -> (Int, Int) -> Term
setter Term
term (Int
newRow, Int
newCol) =
      Bool -> Term -> Term
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
newCol Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
minX) (Term -> Term) -> Term -> Term
forall a b. (a -> b) -> a -> b
$
        Bool -> Term -> Term
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
newCol Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxX) (Term -> Term) -> Term -> Term
forall a b. (a -> b) -> a -> b
$
          Bool -> Term -> Term
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
newRow Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
minY) (Term -> Term) -> Term -> Term
forall a b. (a -> b) -> a -> b
$
            Bool -> Term -> Term
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
newRow Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxY) (Term -> Term) -> Term -> Term
forall a b. (a -> b) -> a -> b
$
              Term
term {term_CursorPos :: CursorPos
term_CursorPos = Int -> Int -> CursorPos
CursorPos Int
newRow Int
newCol}
      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
        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

cursorState :: Lens' Term CursorState
cursorState :: (CursorState -> f CursorState) -> Term -> f Term
cursorState = (Term -> CursorState)
-> (Term -> CursorState -> Term)
-> Lens Term Term CursorState CursorState
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Term -> CursorState
term_CursorState (\Term
term CursorState
newVal -> Term
term {term_CursorState :: CursorState
term_CursorState = CursorState
newVal})

-- | Wraparound Mode (DECAWM)
modeWrap :: Lens' Term Bool
modeWrap :: (Bool -> f Bool) -> Term -> f Term
modeWrap = (Term -> Bool)
-> (Term -> Bool -> Term) -> Lens Term Term Bool Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Term -> Bool
term_ModeWrap (\Term
term Bool
newVal -> Term
term {term_ModeWrap :: Bool
term_ModeWrap = Bool
newVal})

-- | Insert/Replace Mode (IRM)
insertMode :: Lens' Term Bool
insertMode :: (Bool -> f Bool) -> Term -> f Term
insertMode = (Term -> Bool)
-> (Term -> Bool -> Term) -> Lens Term Term Bool Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Term -> Bool
term_InsertMode (\Term
term Bool
newVal -> Term
term {term_InsertMode :: Bool
term_InsertMode = Bool
newVal})

altScreenActive :: Lens' Term Bool
altScreenActive :: (Bool -> f Bool) -> Term -> f Term
altScreenActive = (Term -> Bool)
-> (Term -> Bool -> Term) -> Lens Term Term Bool Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Term -> Bool
term_AltScreenActive (\Term
term Bool
newVal -> Term
term {term_AltScreenActive :: Bool
term_AltScreenActive = Bool
newVal})

numCols :: Lens' Term Int
numCols :: (Int -> f Int) -> Term -> f Term
numCols = (Term -> Int) -> (Term -> Int -> Term) -> Lens' Term Int
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Term -> Int
term_NumCols (\Term
term Int
newVal -> Term
term {term_NumCols :: Int
term_NumCols = Int
newVal})

numRows :: Lens' Term Int
numRows :: (Int -> f Int) -> Term -> f Term
numRows = (Term -> Int) -> (Term -> Int -> Term) -> Lens' Term Int
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Term -> Int
term_NumRows (\Term
term Int
newVal -> Term
term {term_NumRows :: Int
term_NumRows = Int
newVal})

keyboardState :: Lens' Term KeyboardState
keyboardState :: (KeyboardState -> f KeyboardState) -> Term -> f Term
keyboardState = (Term -> KeyboardState)
-> (Term -> KeyboardState -> Term)
-> Lens Term Term KeyboardState KeyboardState
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Term -> KeyboardState
term_KeyboardState (\Term
term KeyboardState
newVal -> Term
term {term_KeyboardState :: KeyboardState
term_KeyboardState = KeyboardState
newVal})

scrollTop :: Lens' Term Int
scrollTop :: (Int -> f Int) -> Term -> f Term
scrollTop = (Term -> Int) -> (Term -> Int -> Term) -> Lens' Term Int
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Term -> Int
term_ScrollTop (\Term
term Int
newVal -> Term
term {term_ScrollTop :: Int
term_ScrollTop = Int
newVal})

scrollBottom :: Lens' Term Int
scrollBottom :: (Int -> f Int) -> Term -> f Term
scrollBottom = (Term -> Int) -> (Term -> Int -> Term) -> Lens' Term Int
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Term -> Int
term_ScrollBottom (\Term
term Int
newVal -> Term
term {term_ScrollBottom :: Int
term_ScrollBottom = Int
newVal})

scrollBackLines :: Lens' Term TermLines
scrollBackLines :: (TermLines -> f TermLines) -> Term -> f Term
scrollBackLines = (Term -> TermLines)
-> (Term -> TermLines -> Term)
-> Lens Term Term TermLines TermLines
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Term -> TermLines
term_ScrollBackLines (\Term
term TermLines
newVal -> Term
term {term_ScrollBackLines :: TermLines
term_ScrollBackLines = TermLines
newVal})

numScrollBackLines :: Lens' Term Int
numScrollBackLines :: (Int -> f Int) -> Term -> f Term
numScrollBackLines = (Term -> Int) -> (Term -> Int -> Term) -> Lens' Term Int
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Term -> Int
term_NumScrollBackLines (\Term
term Int
newVal -> Term
term {term_NumScrollBackLines :: Int
term_NumScrollBackLines = Int
newVal})

termScreen :: Lens' Term TermLines
termScreen :: (TermLines -> f TermLines) -> Term -> f Term
termScreen = (Term -> TermLines)
-> (Term -> TermLines -> Term)
-> Lens Term Term TermLines TermLines
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Term -> TermLines
term_Screen (\Term
term TermLines
newVal -> Term
term {term_Screen :: TermLines
term_Screen = TermLines
newVal})

termAlt :: Lens' Term TermLines
termAlt :: (TermLines -> f TermLines) -> Term -> f Term
termAlt = (Term -> TermLines)
-> (Term -> TermLines -> Term)
-> Lens Term Term TermLines TermLines
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Term -> TermLines
term_Alt (\Term
term TermLines
newVal -> Term
term {term_Alt :: TermLines
term_Alt = TermLines
newVal})

windowTitle :: Lens' Term Text
windowTitle :: (Text -> f Text) -> Term -> f Term
windowTitle = (Term -> Text)
-> (Term -> Text -> Term) -> Lens Term Term Text Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Term -> Text
term_WindowTitle (\Term
term Text
newWindowTitle -> Term
term {term_WindowTitle :: Text
term_WindowTitle = Text
newWindowTitle})

-----------------------------------------------------------------------
-- Direct 'Term' Lenses
-----------------------------------------------------------------------

wrapNext :: Lens' CursorState Bool
wrapNext :: (Bool -> f Bool) -> CursorState -> f CursorState
wrapNext = (CursorState -> Bool)
-> (CursorState -> Bool -> CursorState)
-> Lens CursorState CursorState Bool Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CursorState -> Bool
cursorState_WrapNext (\CursorState
cs Bool
newWrapNext -> CursorState
cs {cursorState_WrapNext :: Bool
cursorState_WrapNext = Bool
newWrapNext})

origin :: Lens' CursorState Bool
origin :: (Bool -> f Bool) -> CursorState -> f CursorState
origin = (CursorState -> Bool)
-> (CursorState -> Bool -> CursorState)
-> Lens CursorState CursorState Bool Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CursorState -> Bool
cursorState_Origin (\CursorState
cs Bool
newOrigin -> CursorState
cs {cursorState_Origin :: Bool
cursorState_Origin = Bool
newOrigin})

-----------------------------------------------------------------------
-- Helper 'Term' Lenses
-----------------------------------------------------------------------

-- | A lens to the line where the cursor currently is
cursorLine :: Lens' Term TermLine
cursorLine :: (Vector (Char, Attrs) -> f (Vector (Char, Attrs)))
-> Term -> f Term
cursorLine = (Term -> Vector (Char, Attrs))
-> (Term -> Vector (Char, Attrs) -> Term)
-> Lens Term Term (Vector (Char, Attrs)) (Vector (Char, Attrs))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Term -> Vector (Char, Attrs)
getter Term -> Vector (Char, Attrs) -> Term
setter
  where
    getter :: Term -> TermLine
    getter :: Term -> Vector (Char, Attrs)
getter Term
term = Term
term Term
-> Getting (Vector (Char, Attrs)) Term (Vector (Char, Attrs))
-> Vector (Char, Attrs)
forall s a. s -> Getting a s a -> a
^. (TermLines -> Const (Vector (Char, Attrs)) TermLines)
-> Term -> Const (Vector (Char, Attrs)) Term
Lens Term Term TermLines TermLines
activeScreen ((TermLines -> Const (Vector (Char, Attrs)) TermLines)
 -> Term -> Const (Vector (Char, Attrs)) Term)
-> ((Vector (Char, Attrs)
     -> Const (Vector (Char, Attrs)) (Vector (Char, Attrs)))
    -> TermLines -> Const (Vector (Char, Attrs)) TermLines)
-> Getting (Vector (Char, Attrs)) Term (Vector (Char, Attrs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Lens' TermLines (Vector (Char, Attrs))
forall a. Int -> Lens' (StrictSeq a) a
TL.vIndex (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 Term (Int, Int) (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)
    setter :: Term -> TermLine -> Term
    setter :: Term -> Vector (Char, Attrs) -> Term
setter Term
term Vector (Char, Attrs)
newTermLine = (((TermLines -> Identity TermLines) -> Term -> Identity Term
Lens Term Term TermLines TermLines
activeScreen ((TermLines -> Identity TermLines) -> Term -> Identity Term)
-> ((Vector (Char, Attrs) -> Identity (Vector (Char, Attrs)))
    -> TermLines -> Identity TermLines)
-> (Vector (Char, Attrs) -> Identity (Vector (Char, Attrs)))
-> Term
-> Identity Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Lens' TermLines (Vector (Char, Attrs))
forall a. Int -> Lens' (StrictSeq a) a
TL.vIndex (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 Term (Int, Int) (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)) ((Vector (Char, Attrs) -> Identity (Vector (Char, Attrs)))
 -> Term -> Identity Term)
-> Vector (Char, Attrs) -> Term -> Term
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Vector (Char, Attrs)
newTermLine) Term
term

-- | Either the main screen or the alternate screen (depending on which is
-- active)
activeScreen :: Lens' Term TermLines
activeScreen :: (TermLines -> f TermLines) -> Term -> f Term
activeScreen = (Term -> TermLines)
-> (Term -> TermLines -> Term)
-> Lens Term Term TermLines TermLines
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Term -> TermLines
getter Term -> TermLines -> Term
setter
  where
    getter :: Term -> TermLines
    getter :: Term -> TermLines
getter Term
term = (if Term -> Bool
term_AltScreenActive Term
term then Term -> TermLines
term_Alt else Term -> TermLines
term_Screen) Term
term
    setter :: Term -> TermLines -> Term
    setter :: Term -> TermLines -> Term
setter Term
term TermLines
newLines = (if Term -> Bool
term_AltScreenActive Term
term then Term
term {term_Alt :: TermLines
term_Alt = TermLines
newLines} else Term
term {term_Screen :: TermLines
term_Screen = TermLines
newLines})

-----------------------------------------------------------------------

termGetKeyboardState :: Term -> KeyboardState
termGetKeyboardState :: Term -> KeyboardState
termGetKeyboardState = Term -> KeyboardState
term_KeyboardState

vuIndex :: VU.Unbox a => Int -> Lens' (VU.Vector a) a
vuIndex :: Int -> Lens' (Vector a) a
vuIndex Int
i = (Vector a -> a)
-> (Vector a -> a -> Vector a) -> Lens' (Vector a) a
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Vector a -> a
forall a. Unbox a => Vector a -> a
getter Vector a -> a -> Vector a
forall a. Unbox a => Vector a -> a -> Vector a
setter
  where
    getter :: VU.Unbox a => VU.Vector a -> a
    getter :: Vector a -> a
getter Vector a
v = Bool -> a -> a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Vector a -> Int
forall a. Unbox a => Vector a -> Int
VU.length Vector a
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Vector a
v Vector a -> Int -> a
forall a. Unbox a => Vector a -> Int -> a
VU.! Int
i
    setter :: VU.Unbox a => VU.Vector a -> a -> VU.Vector a
    setter :: Vector a -> a -> Vector a
setter Vector a
v a
val = Bool -> Vector a -> Vector a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Vector a -> Int
forall a. Unbox a => Vector a -> Int
VU.length Vector a
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Vector a -> Vector a) -> Vector a -> Vector a
forall a b. (a -> b) -> a -> b
$ Vector a
v Vector a -> [(Int, a)] -> Vector a
forall a. Unbox a => Vector a -> [(Int, a)] -> Vector a
VU.// [(Int
i, a
val)]

addScrollBackLines :: TermLines -> Term -> Term
addScrollBackLines :: TermLines -> Term -> Term
addScrollBackLines TermLines
newLines Term
term =
  ((TermLines -> Identity TermLines) -> Term -> Identity Term
Lens Term Term TermLines TermLines
scrollBackLines ((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 -> TermLines -> TermLines
forall a. Semigroup a => a -> a -> a
<> TermLines
newLines) (TermLines -> TermLines)
-> (TermLines -> TermLines) -> TermLines -> TermLines
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Int -> TermLines -> TermLines
forall a. Int -> StrictSeq a -> StrictSeq a
TL.takeLast (Term
term Term -> Getting Int Term Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Term Int
Lens' Term Int
numScrollBackLines))) Term
term