{-| Description: Text- and character-rendering widgets -} module Reflex.Vty.Widget.Text where import Control.Monad.Fix import Data.Default import Data.Text (Text) import qualified Data.Text as T import Data.Text.Zipper as TZ import qualified Graphics.Vty as V import Reflex import Reflex.Vty.Widget import Reflex.Vty.Widget.Scroll -- | Fill the background with a particular character. fill :: (HasDisplayRegion t m, HasImageWriter t m, HasTheme t m) => Behavior t Char -> m () fill bc = do dw <- displayWidth dh <- displayHeight bt <- theme let fillImg = (\attr w h c -> [V.charFill attr c w h]) <$> bt <*> current dw <*> current dh <*> bc tellImages fillImg -- | Configuration options for displaying "rich" text data RichTextConfig t = RichTextConfig { _richTextConfig_attributes :: Behavior t V.Attr } instance Reflex t => Default (RichTextConfig t) where def = RichTextConfig $ pure V.defAttr -- TODO delete this and use new local theming -- | A widget that displays text with custom time-varying attributes richText :: (Reflex t, Monad m, HasDisplayRegion t m, HasImageWriter t m, HasTheme t m) => RichTextConfig t -> Behavior t Text -> m () richText cfg t = do dw <- displayWidth let img = (\w a s -> [wrapText w a s]) <$> current dw <*> _richTextConfig_attributes cfg <*> t tellImages img where wrapText maxWidth attrs = V.vertCat . concatMap (fmap (V.string attrs . T.unpack) . TZ.wrapWithOffset maxWidth 0) . T.split (=='\n') -- | Renders text, wrapped to the container width text :: (Reflex t, Monad m, HasDisplayRegion t m, HasImageWriter t m, HasTheme t m) => Behavior t Text -> m () text t = do bt <- theme richText (RichTextConfig bt) t -- | Renders any behavior whose value can be converted to -- 'String' as text display :: (Reflex t, Monad m, Show a, HasDisplayRegion t m, HasImageWriter t m, HasTheme t m) => Behavior t a -> m () display a = text $ T.pack . show <$> a -- | Scrollable text widget. The output exposes the current scroll position and -- total number of lines (including those that are hidden) scrollableText :: forall t m. (Reflex t, MonadHold t m, MonadFix m, HasDisplayRegion t m, HasInput t m, HasImageWriter t m, HasTheme t m, PostBuild t m) => ScrollableConfig t -> Dynamic t Text -> m (Scrollable t) scrollableText cfg t = do scrollable cfg $ do ((), images) <- runImageWriter $ text (current t) pure $ (V.vertCat <$> images, () <$ updated t)