mirror of
https://github.com/jtdaugherty/brick.git
synced 2024-12-12 12:23:21 +03:00
156 lines
4.6 KiB
Haskell
156 lines
4.6 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
module Main where
|
|
|
|
import Control.Lens
|
|
import Control.Monad (void)
|
|
import Data.Monoid
|
|
import Graphics.Vty hiding (translate)
|
|
import qualified Data.Text as T
|
|
|
|
import Brick.Main
|
|
import Brick.Core
|
|
import Brick.Widgets.Core
|
|
import Brick.Widgets.Center
|
|
import Brick.Widgets.Border
|
|
import Brick.Widgets.Border.Style
|
|
import Brick.Widgets.Edit
|
|
import Brick.Widgets.List
|
|
import Brick.Util
|
|
import Brick.AttrMap
|
|
import Brick.Markup
|
|
import Data.Text.Markup
|
|
|
|
styles :: [(T.Text, BorderStyle)]
|
|
styles =
|
|
[ ("ascii", ascii)
|
|
, ("uni", unicode)
|
|
, ("uni-bold", unicodeBold)
|
|
, ("uni-rounded", unicodeRounded)
|
|
]
|
|
|
|
data St =
|
|
St { _stEditor :: Editor
|
|
, _stList :: List Int
|
|
, _stBorderStyle :: Int
|
|
, _stTrans :: Location
|
|
}
|
|
|
|
makeLenses ''St
|
|
|
|
keywordAttr :: AttrName
|
|
keywordAttr = "app" <> "keyword"
|
|
|
|
editHighlightedKw1Attr :: AttrName
|
|
editHighlightedKw1Attr = editAttr <> "kw1"
|
|
|
|
editHighlightedKw2Attr :: AttrName
|
|
editHighlightedKw2Attr = editAttr <> "kw2"
|
|
|
|
kw :: Widget -> Widget
|
|
kw = withAttr keywordAttr
|
|
|
|
highlightWord :: (Eq a) => String -> a -> Markup a -> Markup a
|
|
highlightWord w att mk = assignAttrs 0 chunks mk
|
|
where
|
|
wordLen = length w
|
|
s = toText mk
|
|
chunks = T.splitOn (T.pack w) s
|
|
|
|
assignAttrs _ [] m = m
|
|
assignAttrs _ [_] m = m
|
|
assignAttrs pos (t:ts) m = markupSet (pos + T.length t, wordLen) att $ assignAttrs (pos + T.length t + wordLen) ts m
|
|
|
|
applyMarkup :: String -> Markup AttrName
|
|
applyMarkup s =
|
|
highlightWord "foo" editHighlightedKw1Attr $
|
|
highlightWord "bar" editHighlightedKw2Attr $
|
|
(T.pack s) @? editAttr
|
|
|
|
drawEditString :: String -> Widget
|
|
drawEditString = markup . applyMarkup
|
|
|
|
drawUI :: St -> [Widget]
|
|
drawUI st = [withBorderStyle bs a]
|
|
where
|
|
(bsName, bs) = styles !! (st^.stBorderStyle)
|
|
box = borderWithLabel (txt bsName) $
|
|
(hLimit 25 (
|
|
(renderEditor $ st^.stEditor)
|
|
<=> hBorder
|
|
<=> (vLimit 10 $ renderList (st^.stList))
|
|
))
|
|
a = translateBy (st^.stTrans) $ vCenter $
|
|
(hCenter box)
|
|
<=> " "
|
|
<=> (hCenter (kw "Enter" <+> " adds a list item"))
|
|
<=> (hCenter (kw "+" <+> " changes border styles"))
|
|
<=> (hCenter (kw "Arrow keys" <+> " navigates the list"))
|
|
<=> (hCenter (kw "Ctrl-Arrow keys" <+> " move the interface"))
|
|
|
|
appEvent :: St -> Event -> EventM (Next St)
|
|
appEvent st e =
|
|
case e of
|
|
EvKey (KChar '+') [] ->
|
|
continue $ st & stBorderStyle %~ ((`mod` (length styles)) . (+ 1))
|
|
|
|
EvKey KEsc [] -> halt st
|
|
|
|
EvKey (KChar 'r') [MCtrl] -> suspendAndResume $ do
|
|
putStrLn "Suspended. Press any key..."
|
|
void getChar
|
|
return st
|
|
|
|
EvKey KUp [MCtrl] -> continue $ st & stTrans.row %~ subtract 1
|
|
EvKey KDown [MCtrl] -> continue $ st & stTrans.row %~ (+ 1)
|
|
|
|
EvKey KLeft [MCtrl] -> continue $ st & stTrans.column %~ (subtract 1)
|
|
EvKey KRight [MCtrl] -> continue $ st & stTrans.column %~ (+ 1)
|
|
|
|
EvKey KEnter [] ->
|
|
let el = length $ st^.stList.listElementsL
|
|
in continue $ st & stList %~ (listMoveBy 1 . listInsert el el)
|
|
|
|
ev -> continue $ st & stEditor %~ (handleEvent ev)
|
|
& stList %~ (handleEvent ev)
|
|
|
|
initialState :: St
|
|
initialState =
|
|
St { _stEditor = editor (Name "edit") drawEditString ""
|
|
, _stList = list (Name "list") listDrawElem []
|
|
, _stBorderStyle = 0
|
|
, _stTrans = Location (0, 0)
|
|
}
|
|
|
|
listDrawElem :: Bool -> Int -> Widget
|
|
listDrawElem sel i =
|
|
let selStr s = if sel then "<" <> s <> ">" else s
|
|
in hCenterWith (Just ' ') $ vBox $ for [1..i+1] $ \j ->
|
|
str $ "Item " <> (selStr $ show i) <> " L" <> show j
|
|
|
|
theAttrMap :: AttrMap
|
|
theAttrMap = attrMap defAttr
|
|
[ (listSelectedAttr, white `on` blue)
|
|
, (editAttr, white `on` blue)
|
|
, (editHighlightedKw1Attr, fg magenta)
|
|
, (editHighlightedKw2Attr, fg cyan)
|
|
, (keywordAttr, fg blue)
|
|
, (borderAttr, fg blue)
|
|
, (hBorderLabelAttr, fg cyan)
|
|
]
|
|
|
|
theApp :: App St Event
|
|
theApp =
|
|
App { appDraw = drawUI
|
|
, appChooseCursor = showFirstCursor
|
|
, appStartEvent = return
|
|
, appHandleEvent = appEvent
|
|
, appAttrMap = const theAttrMap
|
|
, appMakeVtyEvent = id
|
|
}
|
|
|
|
main :: IO ()
|
|
main = do
|
|
st <- defaultMain theApp initialState
|
|
putStrLn $ "You entered: " <> (st^.stEditor.editContentsL)
|