mirror of
https://github.com/jtdaugherty/brick.git
synced 2024-07-14 19:10:29 +03:00
6f1b62ae53
This change is motivated by the API wart that results from the overloading of both "<>" and string literals that resulted in code like this: a :: AttrName a = "blah" <> "things" While this worked to create an AttrName with two segments, it is far too easy to read this as two strings concatenated. The overloading hides what is really going on with the segments of the attribute name. The way to write the above example after this change is: a :: AttrName a = attrName "blah" <> attrName "things"
106 lines
3.0 KiB
Haskell
106 lines
3.0 KiB
Haskell
{-# LANGUAGE CPP #-}
|
|
module Main where
|
|
|
|
import Lens.Micro ((^.))
|
|
import Lens.Micro.Mtl
|
|
import Control.Monad (void)
|
|
import Control.Monad.State (modify)
|
|
#if !(MIN_VERSION_base(4,11,0))
|
|
import Data.Monoid
|
|
#endif
|
|
import Data.Maybe (fromMaybe)
|
|
import qualified Graphics.Vty as V
|
|
|
|
import qualified Brick.Main as M
|
|
import qualified Brick.Types as T
|
|
import qualified Brick.Widgets.Border as B
|
|
import qualified Brick.Widgets.List as L
|
|
import qualified Brick.Widgets.Center as C
|
|
import qualified Brick.AttrMap as A
|
|
import qualified Data.Vector as Vec
|
|
import Brick.Types
|
|
( Widget
|
|
)
|
|
import Brick.Widgets.Core
|
|
( (<+>)
|
|
, str
|
|
, vLimit
|
|
, hLimit
|
|
, vBox
|
|
, withAttr
|
|
)
|
|
import Brick.Util (fg, on)
|
|
|
|
drawUI :: (Show a) => L.List () a -> [Widget ()]
|
|
drawUI l = [ui]
|
|
where
|
|
label = str "Item " <+> cur <+> str " of " <+> total
|
|
cur = case l^.(L.listSelectedL) of
|
|
Nothing -> str "-"
|
|
Just i -> str (show (i + 1))
|
|
total = str $ show $ Vec.length $ l^.(L.listElementsL)
|
|
box = B.borderWithLabel label $
|
|
hLimit 25 $
|
|
vLimit 15 $
|
|
L.renderList listDrawElement True l
|
|
ui = C.vCenter $ vBox [ C.hCenter box
|
|
, str " "
|
|
, C.hCenter $ str "Press +/- to add/remove list elements."
|
|
, C.hCenter $ str "Press Esc to exit."
|
|
]
|
|
|
|
appEvent :: T.BrickEvent () e -> T.EventM () (L.List () Char) ()
|
|
appEvent (T.VtyEvent e) =
|
|
case e of
|
|
V.EvKey (V.KChar '+') [] -> do
|
|
els <- use L.listElementsL
|
|
let el = nextElement els
|
|
pos = Vec.length els
|
|
modify $ L.listInsert pos el
|
|
|
|
V.EvKey (V.KChar '-') [] -> do
|
|
sel <- use L.listSelectedL
|
|
case sel of
|
|
Nothing -> return ()
|
|
Just i -> modify $ L.listRemove i
|
|
|
|
V.EvKey V.KEsc [] -> M.halt
|
|
|
|
ev -> L.handleListEvent ev
|
|
where
|
|
nextElement :: Vec.Vector Char -> Char
|
|
nextElement v = fromMaybe '?' $ Vec.find (flip Vec.notElem v) (Vec.fromList ['a' .. 'z'])
|
|
appEvent _ = return ()
|
|
|
|
listDrawElement :: (Show a) => Bool -> a -> Widget ()
|
|
listDrawElement sel a =
|
|
let selStr s = if sel
|
|
then withAttr customAttr (str $ "<" <> s <> ">")
|
|
else str s
|
|
in C.hCenter $ str "Item " <+> (selStr $ show a)
|
|
|
|
initialState :: L.List () Char
|
|
initialState = L.list () (Vec.fromList ['a','b','c']) 1
|
|
|
|
customAttr :: A.AttrName
|
|
customAttr = L.listSelectedAttr <> A.attrName "custom"
|
|
|
|
theMap :: A.AttrMap
|
|
theMap = A.attrMap V.defAttr
|
|
[ (L.listAttr, V.white `on` V.blue)
|
|
, (L.listSelectedAttr, V.blue `on` V.white)
|
|
, (customAttr, fg V.cyan)
|
|
]
|
|
|
|
theApp :: M.App (L.List () Char) e ()
|
|
theApp =
|
|
M.App { M.appDraw = drawUI
|
|
, M.appChooseCursor = M.showFirstCursor
|
|
, M.appHandleEvent = appEvent
|
|
, M.appStartEvent = return ()
|
|
, M.appAttrMap = const theMap
|
|
}
|
|
|
|
main :: IO ()
|
|
main = void $ M.defaultMain theApp initialState
|