TextContainer.hs

module UI.Widgets.Spade.TextContainer where

import qualified Data.Text as T
import Data.Typeable
import qualified System.Console.ANSI as A

import Common
import UI.Chars
import DiffRender.DiffRender
import UI.Widgets.Common

data TextContainerWidget = TextContainerWidget
  { tcwContent      :: Text
  , tcwDim          :: Dimensions
  , tcwPos          :: ScreenPos
  , tcwVisibility   :: Bool
  , tcwFocused      :: Bool
  , tcwScrollOffset :: Int
  }

instance Container TextContainerWidget Text where
  setContent ref t = do
    modifyWRef ref (\tcw -> tcw { tcwContent = t })
  getContent ref =
    tcwContent <$> readWRef ref

instance Widget TextContainerWidget where
  hasCapability (ContainerCap _ (_ :: Proxy cnt)) = case eqT @cnt @Text of
    Just Refl -> Just Dict
    Nothing   -> Nothing
  hasCapability (DrawableCap _) = Just Dict
  hasCapability (MoveableCap _) = Just Dict
  hasCapability (FocusableCap _)  = Just Dict
  hasCapability (KeyInputCap _)  = Just Dict
  hasCapability _ = Nothing

instance KeyInput TextContainerWidget where
  getCursorInfo _ = pure Nothing
  handleInput ref ev = case ev of
    KeyCtrl _ _ _ ArrowUp -> modifyWRef ref (scroll -1)
    KeyCtrl _ _ _ ArrowDown -> modifyWRef ref (scroll 1)
    _ -> pass

scroll :: Int -> TextContainerWidget -> TextContainerWidget
scroll d w =
  let
    contentWidth = (diW $ tcwDim w) - 2
    contentHeight = (diH $ tcwDim w)
    contentLines' =
      Prelude.concat $ (chunksOf contentWidth <$> (splitOn "\n" (tcwContent w)))
    contentLinesSize = Prelude.length contentLines'
    maxScrollOffset = max 0 (contentLinesSize - contentHeight)
    newScrollOffset = tcwScrollOffset w + d
  in w { tcwScrollOffset = min maxScrollOffset (max 0 newScrollOffset) }

instance Moveable TextContainerWidget where
  getPos ref = tcwPos <$> readWRef ref
  move ref pos =
    modifyWRef ref (\tcw -> tcw { tcwPos = pos })
  getDim ref = tcwDim <$> readWRef ref
  resize ref cb =
    modifyWRef ref (\tcw -> tcw { tcwDim = cb $ tcwDim tcw })

instance Focusable TextContainerWidget where
  setFocus ref b =
    modifyWRef ref (\w -> w { tcwFocused = b })
  getFocus ref =
    tcwFocused <$> (readWRef ref)

instance Drawable TextContainerWidget where
  setVisibility ref v = modifyWRef ref (\b -> b { tcwVisibility = v })
  getVisibility ref = tcwVisibility <$> readWRef ref
  draw :: forall m. WidgetC m => WRef TextContainerWidget -> m ()
  draw ref = do
    w <- readWRef ref
    let
      styleFn = if tcwFocused w
        then (\x -> StyledText (Fg A.Red) [Plain x])
        else Plain

    -- drawBorderBox' (tcwPos w) (tcwDim w) styleFn
    forM_ [0..(diH $ tcwDim w)] (\r -> do
      wSetCursor $ moveDown r (tcwPos w)
      csPutText $ styleFn $ T.singleton verticalLine
      )
    let
      contentWidth = (diW $ tcwDim w) - 2
      contentHeight = (diH $ tcwDim w)
      contentLines =
        Prelude.concat (chunksOf contentWidth <$> (splitOn "\n" (tcwContent w)))
      contentLinesSize = Prelude.length contentLines
      visibleContentLines = Prelude.take contentHeight $
        Prelude.drop (tcwScrollOffset w) contentLines
      maxScrollOffset = max 0 (contentLinesSize - contentHeight)
      maxScrollbarPos = contentHeight - 1 -- Top most position of scroll bar is zero. This is converted to relative location later.
      mScrollbarPos = if maxScrollOffset > 0 then Just $ max 0 $ min maxScrollbarPos (div (maxScrollbarPos * (div (tcwScrollOffset w * 100) maxScrollOffset)) 100) else Nothing
    let
      printLine :: (Int, Text) -> m ()
      printLine (ln, c) = do
        wSetCursor $ moveDown ln (moveRight 1 $ tcwPos w)
        csPutText $ Plain c
    let emp = T.replicate ((diW $ tcwDim w) - 2) " "
    mapM_ printLine (Prelude.zip [0..] (Prelude.take ((diH $ tcwDim w) - 2) $ Prelude.repeat emp))
    mapM_ printLine (Prelude.zip [0..] visibleContentLines)
    if (tcwFocused w) then
      case mScrollbarPos of
        Just scrollbarPos -> do
          wSetCursor $ moveDown scrollbarPos (moveRight ((diW $ tcwDim w) - 1) $ tcwPos w)
          csPutText $ Plain (T.singleton block)
        Nothing -> pass
      else pass
    where

textContainer
  :: WidgetC m
  => ScreenPos
  -> Dimensions
  -> m (WRef TextContainerWidget)
textContainer sp dim = newWRef $ TextContainerWidget "" dim sp True False 0