-- |This module provides visual borders to be placed between and
-- around widgets.
module Graphics.Vty.Widgets.Borders
    ( vBorder
    , hBorder
    , vBorderWith
    , hBorderWith
    , bordered
    )
where

import Graphics.Vty
    ( Attr
    , DisplayRegion(DisplayRegion)
    , char_fill
    , region_height
    , region_width
    )
import Graphics.Vty.Widgets.Rendering
    ( Widget(..)
    , Render
    , Orientation(..)
    , renderImg
    , renderMany
    , renderWidth
    , renderHeight
    )
import Graphics.Vty.Widgets.Base
    ( (<++>)
    )
import Graphics.Vty.Widgets.Text
    ( simpleText
    )

-- |Create a single-row horizontal border.
hBorder :: Attr -> Widget
hBorder = hBorderWith '-'

-- |Create a single-row horizontal border using the specified
-- attribute and character.
hBorderWith :: Char -> Attr -> Widget
hBorderWith ch att =
    Widget { growVertical = False
           , growHorizontal = True
           , primaryAttribute = att
           , withAttribute = hBorder
           , render = \s -> renderImg $ char_fill att ch (region_width s) 1
           }

-- |Create a single-column vertical border.
vBorder :: Attr -> Widget
vBorder = vBorderWith '|'

-- |Create a single-column vertical border using the specified
-- attribute and character.
vBorderWith :: Char -> Attr -> Widget
vBorderWith ch att =
    Widget { growHorizontal = False
           , growVertical = True
           , primaryAttribute = att
           , render = \s -> renderImg $ char_fill att ch 1 (region_height s)
           , withAttribute = vBorder
           }

-- |Wrap a widget in a bordering box using the specified attribute.
bordered :: Attr -> Widget -> Widget
bordered att w = Widget {
                   growVertical = growVertical w
                 , growHorizontal = growHorizontal w
                 , primaryAttribute = att
                 , withAttribute = \att' -> bordered att' (withAttribute w att')
                 , render = renderBordered att w
                 }

renderBordered :: Attr -> Widget -> DisplayRegion -> Render
renderBordered att w s =
    -- Render the contained widget with enough room to draw borders.
    -- Then, use the size of the rendered widget to constrain the
    -- space used by the (expanding) borders.
    renderMany Vertical [topBottom, middle, topBottom]
        where
          constrained = DisplayRegion (region_width s - 2) (region_height s - 2)
          renderedChild = render w constrained
          adjusted = DisplayRegion
                     (renderWidth renderedChild + 2)
                     (renderHeight renderedChild)
          corner = simpleText att "+"
          topBottom = render (corner <++> hBorder att <++> corner) adjusted
          leftRight = render (vBorder att) adjusted
          middle = renderMany Horizontal [leftRight, renderedChild, leftRight]