module Graphics.Vty.Widgets.Text
( Text(tokens)
, FormattedText
, Formatter
, setText
, prepareText
, plainText
, textWidget
, (&.&)
, highlight
, nullFormatter
, wrap
)
where
import Control.Monad.Trans
import Data.Maybe
import Data.Word
import Graphics.Vty
import Graphics.Vty.Widgets.Core
import Text.Trans.Tokenize
import Text.Regex.PCRE.Light.Char8
import Graphics.Vty.Widgets.Util
type Formatter = DisplayRegion -> Text -> Text
(&.&) :: Formatter -> Formatter -> Formatter
f1 &.& f2 = \sz -> f2 sz . f1 sz
nullFormatter :: Formatter
nullFormatter = const id
data Text = Text { tokens :: [[Token Attr]]
}
deriving (Show)
data FormattedText =
FormattedText { text :: Text
, formatter :: Formatter
}
instance Show FormattedText where
show (FormattedText t _) = concat [ "FormattedText { "
, "text = ", show t
, ", formatter = ... }"
]
prepareText :: String -> Text
prepareText s = Text { tokens = tokenize s def_attr
}
plainText :: (MonadIO m) => String -> m (Widget FormattedText)
plainText s = textWidget nullFormatter s
wrap :: Formatter
wrap sz t = t { tokens = newTokens }
where
doWrapping l = if null l then [[]] else wrapLine width l
newTokens = concatMap doWrapping $ tokens t
width = fromEnum $ region_width sz
highlight :: Regex -> Attr -> Formatter
highlight regex attr =
\_ t -> t { tokens = map (map (annotate (matchesRegex regex) attr)) $ tokens t }
annotate :: (Token a -> Bool) -> a -> Token a -> Token a
annotate f ann t = if f t then t `withAnnotation` ann else t
matchesRegex :: Regex -> Token a -> Bool
matchesRegex r t = isJust $ match r (tokenString t) [exec_anchored]
textWidget :: (MonadIO m) => Formatter -> String -> m (Widget FormattedText)
textWidget format s = do
wRef <- newWidget $ \w ->
w { state = FormattedText { text = prepareText s
, formatter = format
}
, render_ =
\this size ctx -> do
ft <- getState this
f <- focused <~ this
return $ renderText (text ft) f (formatter ft) size ctx
}
return wRef
setText :: (MonadIO m) => Widget FormattedText -> String -> m ()
setText wRef s = do
updateWidgetState wRef $ \st ->
st { text = (prepareText s) }
renderText :: Text -> Bool -> Formatter -> DisplayRegion -> RenderContext -> Image
renderText t foc format sz ctx =
if region_height sz == 0
then nullImg
else if null ls || all null ls
then nullImg
else vert_cat $ take (fromEnum $ region_height sz) lineImgs
where
attr' = mergeAttrs [ if foc then focusAttr ctx else overrideAttr ctx
, normalAttr ctx
]
tokenAttr tok = mergeAttrs [ if foc then focusAttr ctx else overrideAttr ctx
, tokenAnnotation tok
, normalAttr ctx
]
lineImgs = map mkLineImg ls
ls = map truncateLine $ tokens newText
truncateLine = truncLine (fromEnum $ region_width sz)
newText = format sz t
mkLineImg line = if null line
then char_fill attr' ' ' (region_width sz) (1::Word)
else horiz_cat $ map mkTokenImg line
nullImg = string def_attr ""
mkTokenImg tok = string (tokenAttr tok) (tokenString tok)