TextContainer.hs

module UI.Widgets.TextContainer where

import Data.Typeable
import qualified Data.Text as T

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

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

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 _ = Nothing

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 Drawable TextContainerWidget where
  setVisibility ref v = modifyWRef ref (\b -> b { tcwVisibility = v })
  getVisibility ref = tcwVisibility <$> readWRef ref
  draw ref = do
    w <- readWRef ref
    forM_ [0..((diH $ tcwDim w) - 1)] (\x -> printOneSoftLine w x ((T.replicate (diW $ tcwDim w) " "), 0))
    foldM_ (printOneLine w) 0 (splitOn "\n" (tcwContent w))
    where
      printOneLine w ln lineContent = do
        ll <- foldM (printOneSoftLine w) ln (Prelude.zip (chunksOf ((diW $ tcwDim w)) lineContent) [0..])
        pure (ll + 1)

      printOneSoftLine w lns (sLineContent, ln') = do
        wSetCursor $ moveDown (lns + ln') (tcwPos w)
        csPutText $ Plain sLineContent
        pure lns

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