module Graphics.Vty.Widgets.Text
( Text(defaultAttr, tokens)
, Formatter
, prepareText
, simpleText
, textWidget
, (&.&)
, highlight
, wrap
)
where
import Data.Maybe
( isJust
)
import Graphics.Vty
( Attr
, DisplayRegion
, string
, def_attr
, horiz_cat
, region_width
, region_height
)
import Graphics.Vty.Widgets.Rendering
( Widget(..)
, Render
, Orientation(Vertical)
, renderMany
, renderImg
)
import Text.Trans.Tokenize
( Token(..)
, tokenize
, withAnnotation
, truncLine
, wrapLine
)
import Text.Regex.PCRE.Light.Char8
( Regex
, match
, exec_anchored
)
type Formatter = DisplayRegion -> Text -> Text
(&.&) :: Formatter -> Formatter -> Formatter
f1 &.& f2 = \sz -> f2 sz . f1 sz
nullFormatter :: Formatter
nullFormatter = const id
data Text = Text { defaultAttr :: Attr
, tokens :: [[Token Attr]]
}
prepareText :: Attr -> String -> Text
prepareText att s = Text { defaultAttr = att
, tokens = tokenize s att
}
simpleText :: Attr -> String -> Widget
simpleText a s = textWidget nullFormatter $ prepareText a s
wrap :: Formatter
wrap sz t = t { tokens = newTokens }
where
newTokens = concatMap (wrapLine width) $ 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 :: Formatter -> Text -> Widget
textWidget formatter t = Widget {
growHorizontal = False
, growVertical = False
, primaryAttribute = defaultAttr t
, withAttribute =
\att -> textWidget formatter $ newText att
, render = renderText t formatter
}
where
newText att = t { tokens = map (map (`withAnnotation` att)) $ tokens t }
renderText :: Text -> Formatter -> DisplayRegion -> Render
renderText t formatter sz =
if region_height sz == 0
then renderImg nullImg
else if null ls || all null ls
then renderImg nullImg
else renderMany Vertical $ take (fromEnum $ region_height sz) lineImgs
where
lineImgs = map (renderImg . mkLineImg) ls
ls = map truncateLine $ tokens newText
truncateLine = truncLine (fromEnum $ region_width sz)
newText = formatter sz t
mkLineImg line = if null line
then string (defaultAttr newText) " "
else horiz_cat $ map mkTokenImg line
nullImg = string def_attr ""
mkTokenImg tok = string (tokenAnnotation tok) (tokenString tok)