-- | TextBox.hs -- A widget which contain mutlicolored text lines with ability of -- scrolling. module Widgets.TextBox ( TextBox(..), TextLine ) where import Graphics.Vty import Graphics.Vty.Widgets.All import Data.List.Split -- | At first goes bottom lines of text for more efficience insert. -- -- line3 -- [line1, line2, line3] -> line2 -- line1 -- -- TODO: scrolling, box sizes data TextBox = TextBox [TextLine] type TextLine = (Attr, String) instance Widget TextBox where growVertical _ = True growHorizontal _ = True primaryAttribute _ = def_attr withAttribute w _ = w -- wrap long lines by screen width and render required part render rgn (TextBox ls) = vert_cat $ (map (uncurry string) ls') ++ [fill] where fill = char_fill def_attr ' ' w (h - (length ls')) ls' = reverse $ take h $ concat $ map wrapLine ls -- do text lines with fixed width wrapLine (a, str) = reverse $ map (\s -> (a, doLong s w)) $ wrapped str -- wrap on newlines then wrap long lines wrapped = concat . map (chunk w) . map processNull . sepBy "\n" processNull "" = replicate w ' ' processNull s = s w = fromIntegral (region_width rgn) h = fromIntegral (region_height rgn) --- doLong s w = let len = length s in if len < w then s ++ replicate (w-len) ' ' else s