RefLabel.hs

module UI.Widgets.Spade.RefLabel where

import qualified Data.Text as T
import Control.Concurrent.STM

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

data TextRefLabelWidget = TextRefLabelWidget
  { trwContent    :: TMVar Value
  , trwDim        :: Dimensions
  , trwPos        :: ScreenPos
  , trwVisibility :: Bool
  }

instance Widget TextRefLabelWidget where
  hasCapability (DrawableCap _) = Just Dict
  hasCapability (MoveableCap _) = Just Dict
  hasCapability _ = Nothing

instance Moveable TextRefLabelWidget where
  getPos ref = trwPos <$> readWRef ref
  move ref pos =
    modifyWRef ref (\tcw -> tcw { trwPos = pos })
  getDim ref = trwDim <$> readWRef ref
  resize ref cb =
    modifyWRef ref (\tcw -> tcw { trwDim = cb $ trwDim tcw })

instance Drawable TextRefLabelWidget where
  setVisibility ref v = modifyWRef ref (\b -> b { trwVisibility = v })
  getVisibility ref = trwVisibility <$> readWRef ref
  draw ref = do
    w <- readWRef ref
    wSetCursor $ (moveRight 1 $ trwPos w)
    csPutText $ Plain $ T.replicate (diW $ trwDim w) " "
    (liftIO $ atomically $ readTMVar (trwContent w)) >>= \case
      StringValue x -> csPutText $ Plain $ T.take (diW $ trwDim w) x
      _ -> error "A text value is required for ref-label"
textRefLabel
  :: WidgetC m
  => ScreenPos
  -> Dimensions
  -> TMVar Value
  -> m (WRef TextRefLabelWidget)
textRefLabel sp dim label = newWRef $ TextRefLabelWidget label dim sp True