brick/programs/BorderDemo.hs

96 lines
2.4 KiB
Haskell
Raw Normal View History

2015-06-28 22:15:55 +03:00
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Applicative ((<$>))
2015-06-28 22:25:21 +03:00
import Data.Monoid
2015-06-28 22:15:55 +03:00
import qualified Data.Text as T
2015-07-10 22:57:19 +03:00
import qualified Graphics.Vty as V
2015-06-28 22:15:55 +03:00
import qualified Brick.Main as M
2015-07-10 22:57:19 +03:00
import Brick.Util (fg, bg, on)
import qualified Brick.AttrMap as A
2015-06-28 22:15:55 +03:00
import Brick.Widgets.Core
2015-07-10 22:57:19 +03:00
( Widget
, (<=>)
, (<+>)
, vLimit
, hLimit
, hBox
, updateAttrMap
, withBorderStyle
, txt
)
import qualified Brick.Widgets.Center as C
2015-07-10 22:57:19 +03:00
import qualified Brick.Widgets.Border as B
import qualified Brick.Widgets.Border.Style as BS
2015-06-28 22:15:55 +03:00
2015-07-10 22:57:19 +03:00
styles :: [(T.Text, BS.BorderStyle)]
2015-06-28 22:15:55 +03:00
styles =
2015-07-10 22:57:19 +03:00
[ ("ascii", BS.ascii)
, ("unicode", BS.unicode)
, ("unicode bold", BS.unicodeBold)
, ("unicode rounded", BS.unicodeRounded)
2015-06-28 22:31:44 +03:00
, ("custom", custom)
2015-07-10 22:57:19 +03:00
, ("from 'x'", BS.borderStyleFromChar 'x')
2015-06-28 22:15:55 +03:00
]
2015-07-10 22:57:19 +03:00
custom :: BS.BorderStyle
2015-06-28 22:31:44 +03:00
custom =
2015-07-10 22:57:19 +03:00
BS.BorderStyle { BS.bsCornerTL = '/'
, BS.bsCornerTR = '\\'
, BS.bsCornerBR = '/'
, BS.bsCornerBL = '\\'
, BS.bsIntersectFull = '.'
, BS.bsIntersectL = '.'
, BS.bsIntersectR = '.'
, BS.bsIntersectT = '.'
, BS.bsIntersectB = '.'
2015-07-10 22:57:19 +03:00
, BS.bsHorizontal = '*'
, BS.bsVertical = '!'
}
2015-06-28 22:31:44 +03:00
2015-06-28 22:15:55 +03:00
borderDemos :: [Widget]
borderDemos = mkBorderDemo <$> styles
2015-07-10 22:57:19 +03:00
mkBorderDemo :: (T.Text, BS.BorderStyle) -> Widget
2015-06-28 22:15:55 +03:00
mkBorderDemo (styleName, sty) =
withBorderStyle sty $
2015-07-10 22:57:19 +03:00
B.borderWithLabel "label" $
2015-06-28 22:15:55 +03:00
vLimit 5 $
C.vCenter $
2015-06-28 22:25:21 +03:00
txt $ " " <> styleName <> " style "
2015-06-28 22:15:55 +03:00
borderMappings :: [(A.AttrName, V.Attr)]
2015-06-28 22:15:55 +03:00
borderMappings =
2015-07-10 22:57:19 +03:00
[ (B.borderAttr, V.yellow `on` V.black)
, (B.vBorderAttr, V.green `on` V.red)
, (B.hBorderAttr, V.white `on` V.green)
, (B.hBorderLabelAttr, fg V.blue)
, (B.tlCornerAttr, bg V.red)
, (B.trCornerAttr, bg V.blue)
, (B.blCornerAttr, bg V.yellow)
, (B.brCornerAttr, bg V.green)
2015-06-28 22:15:55 +03:00
]
colorDemo :: Widget
colorDemo =
updateAttrMap (A.applyAttrMappings borderMappings) $
2015-07-10 22:57:19 +03:00
B.borderWithLabel "title" $
2015-06-28 22:15:55 +03:00
hLimit 20 $
vLimit 5 $
C.center $
2015-06-28 22:25:21 +03:00
"colors!"
2015-06-28 22:15:55 +03:00
ui :: Widget
ui =
hBox borderDemos
2015-07-10 22:57:19 +03:00
<=> B.hBorder
<=> colorDemo
2015-07-10 22:57:19 +03:00
<=> B.hBorderWithLabel "horizontal border label"
<=> (C.center "Left of vertical border"
2015-07-10 22:57:19 +03:00
<+> B.vBorder
<+> C.center "Right of vertical border")
2015-06-28 22:15:55 +03:00
main :: IO ()
main = M.simpleMain ui