TextContainer.hs

module UI.Widgets.TextContainer where

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 _ = 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
    foldM_ (printOneLine w) 0 (splitOn "\n" (tcwContent w))
    where
      printOneLine w ln lineContent = do
        ll <- foldM printOneSoftLine ln (Prelude.zip (chunksOf ((diW $ tcwDim w) - 2) lineContent) [0..])
        pure (ll + 1)
        where
          printOneSoftLine 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