Add demonstration program for borders

brick.cabal

@@ -82,6 +82,18 @@ executable brick-minimal
                        text,
                        lens
 
+executable brick-border-demo
+  hs-source-dirs:      programs
+  ghc-options:         -threaded -Wall -fno-warn-unused-do-bind
+  default-language:    Haskell2010
+  main-is:             BorderDemo.hs
+  build-depends:       base,
+                       brick,
+                       vty >= 5.2.9,
+                       data-default,
+                       text,
+                       lens
+
 executable brick-rogue
   hs-source-dirs:      programs
   ghc-options:         -threaded -Wall -fno-warn-unused-do-bind

programs/BorderDemo.hs

@@ -0,0 +1,61 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Main where
+
+import Control.Applicative ((<$>))
+import qualified Data.Text as T
+import Graphics.Vty
+
+import Brick.Main
+import Brick.Util
+import Brick.AttrMap
+import Brick.Widgets.Core
+import Brick.Widgets.Center
+import Brick.Widgets.Border
+import Brick.Widgets.Border.Style
+
+styles :: [(T.Text, BorderStyle)]
+styles =
+    [ ("ascii", ascii)
+    , ("unicode", unicode)
+    , ("unicode bold", unicodeBold)
+    , ("unicode rounded", unicodeRounded)
+    ]
+
+borderDemos :: [Widget]
+borderDemos = mkBorderDemo <$> styles
+
+mkBorderDemo :: (T.Text, BorderStyle) -> Widget
+mkBorderDemo (styleName, sty) =
+    withBorderStyle sty $
+    border $
+    hLimit 20 $
+    vLimit 5 $
+    center $
+    txt styleName
+
+borderMappings :: [(AttrName, Attr)]
+borderMappings =
+    [ (borderAttr,         yellow `on` black)
+    , (vBorderAttr,        green `on` red)
+    , (hBorderAttr,        white `on` green)
+    , (hBorderLabelAttr,   fg blue)
+    , (tlCornerAttr,       bg red)
+    , (trCornerAttr,       bg blue)
+    , (blCornerAttr,       bg yellow)
+    , (brCornerAttr,       bg green)
+    ]
+
+colorDemo :: Widget
+colorDemo =
+    withAttrMappings borderMappings $
+    borderWithLabel "title" $
+    hLimit 20 $
+    vLimit 5 $
+    center $
+    "body"
+
+ui :: [Widget]
+ui = [hBox borderDemos <=> colorDemo]
+
+main :: IO ()
+main = simpleMain [] ui