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