-- | 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.
--
--                          line1
-- [line3, line2, line1] -> line2
--                          line3
--
-- 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
        wrapLine (attr, str)
          = reverse $ zip (repeat attr) (wrapStr $ sepBy "\n" str)
        -- wrap on newlines then wrap long lines
        -- Example:
        -- 15:08:12 ** Topic: ExplicitCall
        --          Don't fear monads - they will sense it and f#ck
        --          you up | клуб любителей (молчать о) Haskell...
        -- ^^^^^^^^^ -- offset
        wrapStr [""] = [" "]
        wrapStr (s:ss) = s1:(concat $ map (map shift . chunk w') (s2:ss'))
          where (s1, s2) = splitAt w s
                ss' = map (\str -> if null str then " " else str) ss
                shift = (replicate offset ' ' ++)
                offset = 9
                w' = w - offset
        w = fromIntegral (region_width rgn)
        h = fromIntegral (region_height rgn)