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 :: WidgetC m => ScreenPos -> Dimensions -> m (WRef TextContainerWidget) textContainer sp dim = newWRef $ TextContainerWidget "" dim sp True