TextLabel.hs

module UI.Widgets.Spade.TextLabel where

import Data.Typeable
import qualified Data.Text as T

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

data TextLabelWidget = TextLabelWidget
  { tlwContent    :: Text
  , tlwDim        :: Dimensions
  , tlwPos        :: ScreenPos
  , tlwVisibility :: Bool
  }

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

instance Widget TextLabelWidget 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 TextLabelWidget where
  getPos ref = tlwPos <$> readWRef ref
  move ref pos =
    modifyWRef ref (\tcw -> tcw { tlwPos = pos })
  getDim ref = tlwDim <$> readWRef ref
  resize ref cb =
    modifyWRef ref (\tcw -> tcw { tlwDim = cb $ tlwDim tcw })

instance Drawable TextLabelWidget where
  setVisibility ref v = modifyWRef ref (\b -> b { tlwVisibility = v })
  getVisibility ref = tlwVisibility <$> readWRef ref
  draw ref = do
    w <- readWRef ref
    wSetCursor $ (moveRight 1 $ tlwPos w)
    csPutText $ Plain $ T.replicate (diW $ tlwDim w) " "
    csPutText $ Plain $ T.take (diW $ tlwDim w) $ tlwContent w

textLabel
  :: WidgetC m
  => ScreenPos
  -> Dimensions
  -> Text
  -> m (WRef TextLabelWidget)
textLabel sp dim label = newWRef $ TextLabelWidget label dim sp True