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.Input.Mouse
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
data RichTextConfig t = RichTextConfig
{ _richTextConfig_attributes :: Behavior t V.Attr
}
instance Reflex t => Default (RichTextConfig t) where
def = RichTextConfig $ pure V.defAttr
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')
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
scrollableText
:: forall t m. (Reflex t, MonadHold t m, MonadFix m, HasDisplayRegion t m, HasInput t m, HasImageWriter t m, HasTheme t m)
=> Event t Int
-> Behavior t Text
-> m (Behavior t (Int, Int))
scrollableText scrollBy t = do
dw <- displayWidth
bt <- theme
let imgs = wrap <$> bt <*> current dw <*> t
kup <- key V.KUp
kdown <- key V.KDown
m <- mouseScroll
let requestedScroll :: Event t Int
requestedScroll = leftmost
[ 1 <$ kdown
, (-1) <$ kup
, ffor m $ \case
ScrollDirection_Up -> (-1)
ScrollDirection_Down -> 1
, scrollBy
]
updateLine maxN delta ix = min (max 0 (ix + delta)) maxN
lineIndex :: Dynamic t Int <- foldDyn (\(maxN, delta) ix -> updateLine (maxN - 1) delta ix) 0 $
attach (length <$> imgs) requestedScroll
tellImages $ fmap ((:[]) . V.vertCat) $ drop <$> current lineIndex <*> imgs
return $ (,) <$> ((+) <$> current lineIndex <*> pure 1) <*> (length <$> imgs)
where
wrap attr maxWidth = concatMap (fmap (V.string attr . T.unpack) . TZ.wrapWithOffset maxWidth 0) . T.split (=='\n')
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