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
|
|
|
|
2015-07-10 23:15:30 +03:00
|
|
|
import qualified Brick.Main as M
|
2015-07-10 22:57:19 +03:00
|
|
|
import Brick.Util (fg, bg, on)
|
2015-07-10 23:15:30 +03:00
|
|
|
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
|
|
|
|
)
|
2015-07-10 23:15:30 +03:00
|
|
|
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 = '\\'
|
2015-07-18 04:37:11 +03:00
|
|
|
, 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 $
|
2015-07-10 23:15:30 +03:00
|
|
|
C.vCenter $
|
2015-06-28 22:25:21 +03:00
|
|
|
txt $ " " <> styleName <> " style "
|
2015-06-28 22:15:55 +03:00
|
|
|
|
2015-07-10 23:15:30 +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 =
|
2015-07-10 23:15:30 +03:00
|
|
|
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 $
|
2015-07-10 23:15:30 +03:00
|
|
|
C.center $
|
2015-06-28 22:25:21 +03:00
|
|
|
"colors!"
|
2015-06-28 22:15:55 +03:00
|
|
|
|
2015-06-28 22:20:40 +03:00
|
|
|
ui :: Widget
|
|
|
|
ui =
|
|
|
|
hBox borderDemos
|
2015-07-10 22:57:19 +03:00
|
|
|
<=> B.hBorder
|
2015-06-28 22:20:40 +03:00
|
|
|
<=> colorDemo
|
2015-07-10 22:57:19 +03:00
|
|
|
<=> B.hBorderWithLabel "horizontal border label"
|
2015-07-10 23:15:30 +03:00
|
|
|
<=> (C.center "Left of vertical border"
|
2015-07-10 22:57:19 +03:00
|
|
|
<+> B.vBorder
|
2015-07-10 23:15:30 +03:00
|
|
|
<+> C.center "Right of vertical border")
|
2015-06-28 22:15:55 +03:00
|
|
|
|
|
|
|
main :: IO ()
|
2015-07-10 23:15:30 +03:00
|
|
|
main = M.simpleMain ui
|