matsuri-0.0.1: Widgets/TextBox.hs

-- | 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