mirror of
https://github.com/jtdaugherty/brick.git
synced 2024-10-27 01:27:24 +03:00
3081e7367d
This experimental change makes it possible to: * Avoid runtime errors due to name typos * Achieve compile-time guarantees about name matching and usage * Force widget functions to be name-agnostic by being polymorphic in their name type * Clean up focus handling by making it possible to pattern-match on cursor location names The change also made many types more heavyweight and in some cases this is unpleasant when we don't want to have to care about names. But in those cases we can just use 'n' or '()' depending on how concrete we need to be. I'm not yet sure how this is going to play out in practice.
100 lines
3.0 KiB
Haskell
100 lines
3.0 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
module Main where
|
|
|
|
import Control.Lens ((^.))
|
|
import Control.Monad (void)
|
|
import Data.Monoid
|
|
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 V
|
|
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 $ V.length $ l^.(L.listElementsL)
|
|
box = B.borderWithLabel label $
|
|
hLimit 25 $
|
|
vLimit 15 $
|
|
L.renderList l listDrawElement
|
|
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 :: L.List () Char -> V.Event -> T.EventM () (T.Next (L.List () Char))
|
|
appEvent l e =
|
|
case e of
|
|
V.EvKey (V.KChar '+') [] ->
|
|
let el = nextElement (L.listElements l)
|
|
pos = V.length $ l^.(L.listElementsL)
|
|
in M.continue $ L.listInsert pos el l
|
|
|
|
V.EvKey (V.KChar '-') [] ->
|
|
case l^.(L.listSelectedL) of
|
|
Nothing -> M.continue l
|
|
Just i -> M.continue $ L.listRemove i l
|
|
|
|
V.EvKey V.KEsc [] -> M.halt l
|
|
|
|
ev -> M.continue =<< L.handleListEvent ev l
|
|
where
|
|
nextElement :: V.Vector Char -> Char
|
|
nextElement v = fromMaybe '?' $ V.find (flip V.notElem v) (V.fromList ['a' .. 'z'])
|
|
|
|
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 () (V.fromList ['a','b','c']) 1
|
|
|
|
customAttr :: A.AttrName
|
|
customAttr = L.listSelectedAttr <> "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) V.Event ()
|
|
theApp =
|
|
M.App { M.appDraw = drawUI
|
|
, M.appChooseCursor = M.showFirstCursor
|
|
, M.appHandleEvent = appEvent
|
|
, M.appStartEvent = return
|
|
, M.appAttrMap = const theMap
|
|
, M.appLiftVtyEvent = id
|
|
}
|
|
|
|
main :: IO ()
|
|
main = void $ M.defaultMain theApp initialState
|