Resize.hs

module System.Terminal.Emulator.Term.Resize
  ( resizeTerm,
  )
where

import Control.Category ((>>>))
import Control.Exception (assert)
import Control.Lens
import qualified Data.Vector.Unboxed as VU
import System.Terminal.Emulator.Term (Term, addScrollBackLines, altScreenActive, cursorPos, numCols, numRows, scrollBackLines, scrollBottom, scrollTop, termAlt, termAttrs, termScreen)
import System.Terminal.Emulator.TermLines (TermLine, TermLines)
import qualified System.Terminal.Emulator.TermLines as TL
import Prelude hiding (lines)

-- | This should be called when the user resizes the terminal window.
--
-- You should also call 'System.Posix.Pty.resizePty', but only afterwards
--
-- The tuple is in the shape @(newWidth, newHeight)@, both must be positive
resizeTerm :: Term -> (Int, Int) -> Term
resizeTerm term (newWidth, newHeight) =
  assert (newWidth > 0) $
    assert (newHeight > 0) $
      ( resizeTermWidth newWidth
          >>> resizeTermHeight newHeight
          >>> scrollTop .~ 0
          >>> scrollBottom .~ (newHeight - 1)
      )
        term

-- Internal function. Resize the terminal, only changing the width.
resizeTermWidth :: Int -> Term -> Term
resizeTermWidth newWidth term =
  ( numCols .~ newWidth
      >>> termScreen %~ fmap adjustLine
      >>> termAlt %~ fmap adjustLine
      >>> scrollBackLines %~ fmap adjustLine
      >>> cursorPos . _2 %~ min (newWidth - 1)
  )
    term
  where
    oldWidth = term ^. numCols

    expandLine :: TermLine -> TermLine
    expandLine = (<> (VU.replicate (newWidth - oldWidth) ((' ', 0))))

    shrinkLine :: TermLine -> TermLine
    shrinkLine = VU.take newWidth

    adjustLine :: TermLine -> TermLine
    adjustLine
      | newWidth > oldWidth = expandLine
      | otherwise = shrinkLine

-- Internal function. Resize the terminal, only changing the height.
resizeTermHeight :: Int -> Term -> Term
resizeTermHeight newHeight term
  | newHeight >= oldHeight = resizeTermHeight' newHeight term
  | otherwise =
    let term' = truncateTermScreenBottom term (oldHeight - newHeight)
     in resizeTermHeight' newHeight term'
  where
    oldHeight = term ^. numRows

resizeTermHeight' :: Int -> Term -> Term
resizeTermHeight' newHeight term =
  ( numRows .~ newHeight
      >>> adjustScreen
      >>> termAlt %~ adjustAltScreen
      >>> cursorPos . _1 %~ min (newHeight - 1)
  )
    term
  where
    oldHeight = term ^. numRows

    newBlankLine = VU.replicate (term ^. numCols) (' ', term ^. termAttrs)

    expandAltScreen :: TermLines -> TermLines
    expandAltScreen = (<> (TL.replicate (newHeight - oldHeight) newBlankLine))

    shrinkAltScreen :: TermLines -> TermLines
    shrinkAltScreen = TL.take newHeight

    adjustAltScreen :: TermLines -> TermLines
    adjustAltScreen
      | newHeight > oldHeight = expandAltScreen
      | otherwise = shrinkAltScreen

    expandScreen :: Term -> Term
    expandScreen =
      ( termScreen
          %~ ( \lines ->
                 TL.takeLast numHistoryLines (term ^. scrollBackLines)
                   <> lines
                   <> TL.replicate numNewBlankLines newBlankLine
             )
      )
        >>> scrollBackLines %~ TL.dropLast numHistoryLines
        >>> moveCursorDown
      where
        numHistoryLines = min (newHeight - oldHeight) (TL.length (term ^. scrollBackLines))
        numNewBlankLines = (newHeight - oldHeight) - numHistoryLines

        moveCursorDown :: Term -> Term
        moveCursorDown
          | term ^. altScreenActive = id
          | otherwise = cursorPos . _1 %~ (+ numHistoryLines)

    shrinkScreen :: Term -> Term
    shrinkScreen =
      (termScreen %~ TL.takeLast newHeight)
        >>> addScrollBackLines (TL.take numShrunkLines (term ^. termScreen))
        >>> moveCursorUp
      where
        numShrunkLines = oldHeight - newHeight
        moveCursorUp :: Term -> Term
        moveCursorUp
          | term ^. altScreenActive = id
          | otherwise = cursorPos . _1 %~ (\y -> max 0 (y - numShrunkLines))

    adjustScreen
      | newHeight > oldHeight = expandScreen
      | otherwise = shrinkScreen

-- | Chop off up to @n@ lines from the bottom of the main screen (only if they
-- are blank and not occupied by the cursor).
--
-- Also modifies the vertical size of the screen according to the number of
-- lines removed (numLines)
truncateTermScreenBottom :: Term -> Int -> Term
truncateTermScreenBottom term numLines
  | numLines == 0 = term
  | term ^. altScreenActive = term
  | term ^. cursorPos . _1 == term ^. numRows - 1 = term
  | not (lineIsBlank lastLine) = term
  | otherwise =
    let term' =
          ( (termScreen %~ (TL.dropLast 1))
              >>> (numRows %~ (subtract 1))
          )
            term
     in truncateTermScreenBottom term' (numLines - 1)
  where
    lastLine = TL.last (term ^. termScreen)
    lineIsBlank :: TermLine -> Bool
    lineIsBlank = VU.all (== (' ', 0))