module Graphics.Vty.Widgets.Text
( FormattedText
, plainText
, plainTextWithAttrs
, textWidget
, setText
, setTextWithAttrs
, setTextFormatter
, setTextAppearFocused
, Formatter
, getTextFormatter
, (&.&)
, highlight
, nullFormatter
, wrap
)
where
import Data.Word
import Graphics.Vty
import Graphics.Vty.Widgets.Core
import Text.Trans.Tokenize
import Text.Regex.Base
import Graphics.Vty.Widgets.Util
type Formatter = DisplayRegion -> TextStream Attr -> IO (TextStream Attr)
(&.&) :: Formatter -> Formatter -> Formatter
f1 &.& f2 = \sz t -> f1 sz t >>= f2 sz
nullFormatter :: Formatter
nullFormatter = \_ t -> return t
data FormattedText =
FormattedText { text :: TextStream Attr
, formatter :: Formatter
, useFocusAttribute :: Bool
}
instance Show FormattedText where
show (FormattedText t _ f) = concat [ "FormattedText { "
, "text = ", show t
, ", formatter = ..."
, ", useFocusAttribute = " ++ show f
, " }"
]
plainText :: String -> IO (Widget FormattedText)
plainText = textWidget nullFormatter
plainTextWithAttrs :: [(String, Attr)] -> IO (Widget FormattedText)
plainTextWithAttrs pairs = do
w <- textWidget nullFormatter ""
setTextWithAttrs w pairs
return w
wrap :: Formatter
wrap sz ts = do
let width = fromEnum $ region_width sz
return $ wrapStream width ts
highlight :: (RegexLike r String) => r -> Attr -> Formatter
highlight regex attr =
\_ (TS ts) -> return $ TS $ map highlightToken ts
where
highlightToken :: TextStreamEntity Attr -> TextStreamEntity Attr
highlightToken NL = NL
highlightToken (T t) =
if tokenAttr t /= def_attr
then T t
else T (highlightToken' t)
highlightToken' :: Token Attr -> Token Attr
highlightToken' t =
if null $ matchAll regex $ tokenStr t
then t
else t { tokenAttr = attr }
textWidget :: Formatter -> String -> IO (Widget FormattedText)
textWidget format s = do
wRef <- newWidget $ \w ->
w { state = FormattedText { text = TS []
, formatter = format
, useFocusAttribute = False
}
, getCursorPosition_ = const $ return Nothing
, render_ =
\this size ctx -> do
ft <- getState this
f <- focused <~ this
appearFocused <- useFocusAttribute <~~ this
renderText (text ft) (f && appearFocused) (formatter ft) size ctx
}
setText wRef s
return wRef
setTextFormatter :: Widget FormattedText -> Formatter -> IO ()
setTextFormatter wRef f = updateWidgetState wRef $ \st ->
st { formatter = f }
getTextFormatter :: Widget FormattedText -> IO Formatter
getTextFormatter = (formatter <~~)
setTextAppearFocused :: Widget FormattedText -> Bool -> IO ()
setTextAppearFocused wRef val = updateWidgetState wRef $ \st ->
st { useFocusAttribute = val }
setText :: Widget FormattedText -> String -> IO ()
setText wRef s = setTextWithAttrs wRef [(s, def_attr)]
setTextWithAttrs :: Widget FormattedText -> [(String, Attr)] -> IO ()
setTextWithAttrs wRef pairs = do
let streams = map (\(s, a) -> tokenize s a) pairs
ts = concat $ map streamEntities streams
updateWidgetState wRef $ \st ->
st { text = TS ts }
renderText :: TextStream Attr
-> Bool
-> Formatter
-> DisplayRegion
-> RenderContext
-> IO Image
renderText t foc format sz ctx = do
TS newText <- format sz t
let attr' = mergeAttrs [ if foc then focusAttr ctx else overrideAttr ctx
, normalAttr ctx
]
finalAttr tok = mergeAttrs [ if foc then focusAttr ctx else overrideAttr ctx
, tokenAttr tok
, normalAttr ctx
]
lineImgs = map mkLineImg ls
ls = map truncLine $ map (map entityToken) $ findLines newText
truncLine = truncateLine (fromEnum $ region_width sz)
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 :: Token Attr -> Image
mkTokenImg tok = string (finalAttr tok) (tokenStr tok)
return $ 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