mirror of
https://github.com/jtdaugherty/brick.git
synced 2024-11-22 05:36:00 +03:00
Replace "Name" type with custom name type variable everywhere
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.
This commit is contained in:
Jonathan Daugherty
parent
ce2b221350
commit
3081e7367d
@ -20,7 +20,7 @@ import Brick.Widgets.Core
|
||||
import Brick.Util (on, fg)
|
||||
import Brick.AttrMap (attrMap, AttrMap)
|
||||
|
||||
ui :: Widget
|
||||
ui :: Widget ()
|
||||
ui =
|
||||
vBox [ str "This text uses the global default attribute."
|
||||
, withAttr "foundFull" $
|
||||
@ -51,7 +51,7 @@ theMap = attrMap globalDefault
|
||||
, ("general" <> "specific", fg cyan)
|
||||
]
|
||||
|
||||
app :: App () Event
|
||||
app :: App () Event ()
|
||||
app =
|
||||
App { appDraw = const [ui]
|
||||
, appHandleEvent = resizeOrQuit
|
||||
|
||||
@ -52,10 +52,10 @@ custom =
|
||||
, BS.bsVertical = '!'
|
||||
}
|
||||
|
||||
borderDemos :: [Widget]
|
||||
borderDemos :: [Widget ()]
|
||||
borderDemos = mkBorderDemo <$> styles
|
||||
|
||||
mkBorderDemo :: (T.Text, BS.BorderStyle) -> Widget
|
||||
mkBorderDemo :: (T.Text, BS.BorderStyle) -> Widget ()
|
||||
mkBorderDemo (styleName, sty) =
|
||||
withBorderStyle sty $
|
||||
B.borderWithLabel (str "label") $
|
||||
@ -75,7 +75,7 @@ borderMappings =
|
||||
, (B.brCornerAttr, bg V.green)
|
||||
]
|
||||
|
||||
colorDemo :: Widget
|
||||
colorDemo :: Widget ()
|
||||
colorDemo =
|
||||
updateAttrMap (A.applyAttrMappings borderMappings) $
|
||||
B.borderWithLabel (str "title") $
|
||||
@ -84,7 +84,7 @@ colorDemo =
|
||||
C.center $
|
||||
str "colors!"
|
||||
|
||||
ui :: Widget
|
||||
ui :: Widget ()
|
||||
ui =
|
||||
hBox borderDemos
|
||||
<=> B.hBorder
|
||||
|
||||
@ -36,14 +36,14 @@ makeLenses ''St
|
||||
data CustomEvent = VtyEvent V.Event
|
||||
| Counter
|
||||
|
||||
drawUI :: St -> [Widget]
|
||||
drawUI :: St -> [Widget ()]
|
||||
drawUI st = [a]
|
||||
where
|
||||
a = (str $ "Last Vty event: " <> (show $ st^.stLastVtyEvent))
|
||||
<=>
|
||||
(str $ "Counter value is: " <> (show $ st^.stCounter))
|
||||
|
||||
appEvent :: St -> CustomEvent -> EventM (Next St)
|
||||
appEvent :: St -> CustomEvent -> EventM () (Next St)
|
||||
appEvent st e =
|
||||
case e of
|
||||
VtyEvent (V.EvKey V.KEsc []) -> halt st
|
||||
@ -56,7 +56,7 @@ initialState =
|
||||
, _stCounter = 0
|
||||
}
|
||||
|
||||
theApp :: App St CustomEvent
|
||||
theApp :: App St CustomEvent ()
|
||||
theApp =
|
||||
App { appDraw = drawUI
|
||||
, appChooseCursor = showFirstCursor
|
||||
|
||||
@ -21,20 +21,20 @@ import qualified Brick.Types as T
|
||||
data Choice = Red | Blue | Green
|
||||
deriving Show
|
||||
|
||||
drawUI :: D.Dialog Choice -> [Widget]
|
||||
drawUI :: D.Dialog () Choice -> [Widget ()]
|
||||
drawUI d = [ui]
|
||||
where
|
||||
ui = D.renderDialog d $ C.hCenter $ padAll 1 $ str "This is the dialog body."
|
||||
|
||||
appEvent :: D.Dialog Choice -> V.Event -> T.EventM (T.Next (D.Dialog Choice))
|
||||
appEvent :: D.Dialog () Choice -> V.Event -> T.EventM () (T.Next (D.Dialog () Choice))
|
||||
appEvent d ev =
|
||||
case ev of
|
||||
V.EvKey V.KEsc [] -> M.halt d
|
||||
V.EvKey V.KEnter [] -> M.halt d
|
||||
_ -> M.continue =<< T.handleEvent ev d
|
||||
_ -> M.continue =<< D.handleDialogEvent ev d
|
||||
|
||||
initialState :: D.Dialog Choice
|
||||
initialState = D.dialog "dialog" (Just "Title") (Just (0, choices)) 50
|
||||
initialState :: D.Dialog () Choice
|
||||
initialState = D.dialog () (Just "Title") (Just (0, choices)) 50
|
||||
where
|
||||
choices = [ ("Red", Red)
|
||||
, ("Blue", Blue)
|
||||
@ -48,7 +48,7 @@ theMap = A.attrMap V.defAttr
|
||||
, (D.buttonSelectedAttr, bg V.yellow)
|
||||
]
|
||||
|
||||
theApp :: M.App (D.Dialog Choice) V.Event
|
||||
theApp :: M.App (D.Dialog () Choice) V.Event ()
|
||||
theApp =
|
||||
M.App { M.appDraw = drawUI
|
||||
, M.appChooseCursor = M.showFirstCursor
|
||||
|
||||
@ -20,33 +20,31 @@ import qualified Brick.Widgets.Edit as E
|
||||
import qualified Brick.AttrMap as A
|
||||
import Brick.Util (on)
|
||||
|
||||
data Name = Edit1
|
||||
| Edit2
|
||||
deriving (Ord, Show, Eq)
|
||||
|
||||
data St =
|
||||
St { _currentEditor :: T.Name
|
||||
, _edit1 :: E.Editor
|
||||
, _edit2 :: E.Editor
|
||||
St { _currentEditor :: Name
|
||||
, _edit1 :: E.Editor Name
|
||||
, _edit2 :: E.Editor Name
|
||||
}
|
||||
|
||||
makeLenses ''St
|
||||
|
||||
firstEditor :: T.Name
|
||||
firstEditor = "edit1"
|
||||
|
||||
secondEditor :: T.Name
|
||||
secondEditor = "edit2"
|
||||
|
||||
switchEditors :: St -> St
|
||||
switchEditors st =
|
||||
let next = if st^.currentEditor == firstEditor
|
||||
then secondEditor else firstEditor
|
||||
let next = if st^.currentEditor == Edit1
|
||||
then Edit2 else Edit1
|
||||
in st & currentEditor .~ next
|
||||
|
||||
currentEditorL :: St -> Lens' St E.Editor
|
||||
currentEditorL :: St -> Lens' St (E.Editor Name)
|
||||
currentEditorL st =
|
||||
if st^.currentEditor == firstEditor
|
||||
if st^.currentEditor == Edit1
|
||||
then edit1
|
||||
else edit2
|
||||
|
||||
drawUI :: St -> [T.Widget]
|
||||
drawUI :: St -> [T.Widget Name]
|
||||
drawUI st = [ui]
|
||||
where
|
||||
ui = C.center $ (str "Input 1 (unlimited): " <+> (hLimit 30 $ vLimit 5 $ E.renderEditor $ st^.edit1)) <=>
|
||||
@ -55,29 +53,30 @@ drawUI st = [ui]
|
||||
str " " <=>
|
||||
str "Press Tab to switch between editors, Esc to quit."
|
||||
|
||||
appEvent :: St -> V.Event -> T.EventM (T.Next St)
|
||||
appEvent :: St -> V.Event -> T.EventM Name (T.Next St)
|
||||
appEvent st ev =
|
||||
case ev of
|
||||
V.EvKey V.KEsc [] -> M.halt st
|
||||
V.EvKey (V.KChar '\t') [] -> M.continue $ switchEditors st
|
||||
V.EvKey V.KBackTab [] -> M.continue $ switchEditors st
|
||||
_ -> M.continue =<< T.handleEventLensed st (currentEditorL st) ev
|
||||
_ -> M.continue =<<
|
||||
T.handleEventLensed st (currentEditorL st) E.handleEditorEvent ev
|
||||
|
||||
initialState :: St
|
||||
initialState =
|
||||
St firstEditor
|
||||
(E.editor firstEditor (str . unlines) Nothing "")
|
||||
(E.editor secondEditor (str . unlines) (Just 2) "")
|
||||
St Edit1
|
||||
(E.editor Edit1 (str . unlines) Nothing "")
|
||||
(E.editor Edit2 (str . unlines) (Just 2) "")
|
||||
|
||||
theMap :: A.AttrMap
|
||||
theMap = A.attrMap V.defAttr
|
||||
[ (E.editAttr, V.white `on` V.blue)
|
||||
]
|
||||
|
||||
appCursor :: St -> [T.CursorLocation] -> Maybe T.CursorLocation
|
||||
appCursor :: St -> [T.CursorLocation Name] -> Maybe (T.CursorLocation Name)
|
||||
appCursor st = M.showCursorNamed (st^.currentEditor)
|
||||
|
||||
theApp :: M.App St V.Event
|
||||
theApp :: M.App St V.Event Name
|
||||
theApp =
|
||||
M.App { M.appDraw = drawUI
|
||||
, M.appChooseCursor = appCursor
|
||||
|
||||
@ -2,7 +2,7 @@ module Main where
|
||||
|
||||
import Brick
|
||||
|
||||
ui :: Widget
|
||||
ui :: Widget ()
|
||||
ui = str "Hello, world!"
|
||||
|
||||
main :: IO ()
|
||||
|
||||
@ -23,23 +23,23 @@ data St =
|
||||
|
||||
makeLenses ''St
|
||||
|
||||
drawUi :: St -> [Widget]
|
||||
drawUi :: St -> [Widget ()]
|
||||
drawUi st =
|
||||
[ topLayer st
|
||||
, bottomLayer st
|
||||
]
|
||||
|
||||
topLayer :: St -> Widget
|
||||
topLayer :: St -> Widget ()
|
||||
topLayer st =
|
||||
translateBy (st^.topLayerLocation) $
|
||||
B.border $ str "Top layer\n(Arrow keys move)"
|
||||
|
||||
bottomLayer :: St -> Widget
|
||||
bottomLayer :: St -> Widget ()
|
||||
bottomLayer st =
|
||||
translateBy (st^.bottomLayerLocation) $
|
||||
B.border $ str "Bottom layer\n(Ctrl-arrow keys move)"
|
||||
|
||||
appEvent :: St -> V.Event -> T.EventM (T.Next St)
|
||||
appEvent :: St -> V.Event -> T.EventM () (T.Next St)
|
||||
appEvent st (V.EvKey V.KDown []) = M.continue $ st & topLayerLocation.rowL %~ (+ 1)
|
||||
appEvent st (V.EvKey V.KUp []) = M.continue $ st & topLayerLocation.rowL %~ (subtract 1)
|
||||
appEvent st (V.EvKey V.KRight []) = M.continue $ st & topLayerLocation.columnL %~ (+ 1)
|
||||
@ -53,7 +53,7 @@ appEvent st (V.EvKey V.KLeft [V.MCtrl]) = M.continue $ st & bottomLayerLocation
|
||||
appEvent st (V.EvKey V.KEsc []) = M.halt st
|
||||
appEvent st _ = M.continue st
|
||||
|
||||
app :: M.App St V.Event
|
||||
app :: M.App St V.Event ()
|
||||
app =
|
||||
M.App { M.appDraw = drawUi
|
||||
, M.appStartEvent = return
|
||||
|
||||
@ -27,7 +27,7 @@ import Brick.Widgets.Core
|
||||
)
|
||||
import Brick.Util (fg, on)
|
||||
|
||||
drawUI :: (Show a) => L.List a -> [Widget]
|
||||
drawUI :: (Show a) => L.List () a -> [Widget ()]
|
||||
drawUI l = [ui]
|
||||
where
|
||||
label = str "Item " <+> cur <+> str " of " <+> total
|
||||
@ -45,7 +45,7 @@ drawUI l = [ui]
|
||||
, C.hCenter $ str "Press Esc to exit."
|
||||
]
|
||||
|
||||
appEvent :: L.List Char -> V.Event -> T.EventM (T.Next (L.List Char))
|
||||
appEvent :: L.List () Char -> V.Event -> T.EventM () (T.Next (L.List () Char))
|
||||
appEvent l e =
|
||||
case e of
|
||||
V.EvKey (V.KChar '+') [] ->
|
||||
@ -60,20 +60,20 @@ appEvent l e =
|
||||
|
||||
V.EvKey V.KEsc [] -> M.halt l
|
||||
|
||||
ev -> M.continue =<< T.handleEvent ev 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 :: (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 (T.Name "list") (V.fromList ['a','b','c']) 1
|
||||
initialState :: L.List () Char
|
||||
initialState = L.list () (V.fromList ['a','b','c']) 1
|
||||
|
||||
customAttr :: A.AttrName
|
||||
customAttr = L.listSelectedAttr <> "custom"
|
||||
@ -85,7 +85,7 @@ theMap = A.attrMap V.defAttr
|
||||
, (customAttr, fg V.cyan)
|
||||
]
|
||||
|
||||
theApp :: M.App (L.List Char) V.Event
|
||||
theApp :: M.App (L.List () Char) V.Event ()
|
||||
theApp =
|
||||
M.App { M.appDraw = drawUI
|
||||
, M.appChooseCursor = M.showFirstCursor
|
||||
|
||||
@ -19,7 +19,7 @@ import Brick.Markup (markup, (@?))
|
||||
import Brick.AttrMap (attrMap, AttrMap)
|
||||
import Data.Text.Markup ((@@))
|
||||
|
||||
ui :: Widget
|
||||
ui :: Widget ()
|
||||
ui = (m1 <=> m2) <+> (padLeft (Pad 1) m3)
|
||||
where
|
||||
m1 = markup $ ("Hello" @@ fg V.blue) <> ", " <> ("world!" @@ fg V.red)
|
||||
@ -32,7 +32,7 @@ theMap = attrMap V.defAttr
|
||||
, ("keyword2", V.white `on` V.blue)
|
||||
]
|
||||
|
||||
app :: App () V.Event
|
||||
app :: App () V.Event ()
|
||||
app =
|
||||
App { appDraw = const [ui]
|
||||
, appHandleEvent = resizeOrQuit
|
||||
|
||||
@ -24,7 +24,7 @@ import Brick.Widgets.Core
|
||||
import Brick.Widgets.Border as B
|
||||
import Brick.Widgets.Center as C
|
||||
|
||||
ui :: Widget
|
||||
ui :: Widget ()
|
||||
ui =
|
||||
vBox [ hBox [ padLeft Max $ vCenter $ str "Left-padded"
|
||||
, B.vBorder
|
||||
@ -46,7 +46,7 @@ ui =
|
||||
, padAll 2 $ str "Padded by 2 on all sides"
|
||||
]
|
||||
|
||||
app :: App () V.Event
|
||||
app :: App () V.Event ()
|
||||
app =
|
||||
App { appDraw = const [ui]
|
||||
, appHandleEvent = resizeOrQuit
|
||||
|
||||
@ -28,14 +28,14 @@ data St =
|
||||
|
||||
makeLenses ''St
|
||||
|
||||
drawUI :: St -> [Widget]
|
||||
drawUI :: St -> [Widget ()]
|
||||
drawUI st = [ui]
|
||||
where
|
||||
ui = vBox [ str $ "External input: \"" <> st^.stExternalInput <> "\""
|
||||
, str "(Press Esc to quit or Space to ask for input)"
|
||||
]
|
||||
|
||||
appEvent :: St -> V.Event -> EventM (Next St)
|
||||
appEvent :: St -> V.Event -> EventM () (Next St)
|
||||
appEvent st e =
|
||||
case e of
|
||||
V.EvKey V.KEsc [] -> halt st
|
||||
@ -50,7 +50,7 @@ initialState =
|
||||
St { _stExternalInput = ""
|
||||
}
|
||||
|
||||
theApp :: App St V.Event
|
||||
theApp :: App St V.Event ()
|
||||
theApp =
|
||||
App { appDraw = drawUI
|
||||
, appChooseCursor = neverShowCursor
|
||||
|
||||
@ -24,42 +24,38 @@ import Brick.Widgets.Core
|
||||
, str
|
||||
)
|
||||
|
||||
vp1Name :: T.Name
|
||||
vp1Name = "demo1"
|
||||
data Name = VP1
|
||||
| VP2
|
||||
| VP3
|
||||
deriving (Ord, Show, Eq)
|
||||
|
||||
vp2Name :: T.Name
|
||||
vp2Name = "demo2"
|
||||
|
||||
vp3Name :: T.Name
|
||||
vp3Name = "demo3"
|
||||
|
||||
drawUi :: () -> [Widget]
|
||||
drawUi :: () -> [Widget Name]
|
||||
drawUi = const [ui]
|
||||
where
|
||||
ui = C.center $ B.border $ hLimit 60 $ vLimit 21 $
|
||||
vBox [ pair, B.hBorder, singleton ]
|
||||
singleton = viewport vp3Name Both $
|
||||
singleton = viewport VP3 Both $
|
||||
vBox $ str "Press ctrl-arrow keys to scroll this viewport horizontally and vertically."
|
||||
: (str <$> [ "Line " <> show i | i <- [2..25::Int] ])
|
||||
pair = hBox [ viewport vp1Name Vertical $
|
||||
pair = hBox [ viewport VP1 Vertical $
|
||||
vBox $ str "Press up and down arrow keys" :
|
||||
str "to scroll this viewport." :
|
||||
(str <$> [ "Line " <> (show i) | i <- [3..50::Int] ])
|
||||
, B.vBorder
|
||||
, viewport vp2Name Horizontal $
|
||||
, viewport VP2 Horizontal $
|
||||
str "Press left and right arrow keys to scroll this viewport."
|
||||
]
|
||||
|
||||
vp1Scroll :: M.ViewportScroll
|
||||
vp1Scroll = M.viewportScroll vp1Name
|
||||
vp1Scroll :: M.ViewportScroll Name
|
||||
vp1Scroll = M.viewportScroll VP1
|
||||
|
||||
vp2Scroll :: M.ViewportScroll
|
||||
vp2Scroll = M.viewportScroll vp2Name
|
||||
vp2Scroll :: M.ViewportScroll Name
|
||||
vp2Scroll = M.viewportScroll VP2
|
||||
|
||||
vp3Scroll :: M.ViewportScroll
|
||||
vp3Scroll = M.viewportScroll vp3Name
|
||||
vp3Scroll :: M.ViewportScroll Name
|
||||
vp3Scroll = M.viewportScroll VP3
|
||||
|
||||
appEvent :: () -> V.Event -> T.EventM (T.Next ())
|
||||
appEvent :: () -> V.Event -> T.EventM Name (T.Next ())
|
||||
appEvent _ (V.EvKey V.KDown [V.MCtrl]) = M.vScrollBy vp3Scroll 1 >> M.continue ()
|
||||
appEvent _ (V.EvKey V.KUp [V.MCtrl]) = M.vScrollBy vp3Scroll (-1) >> M.continue ()
|
||||
appEvent _ (V.EvKey V.KRight [V.MCtrl]) = M.hScrollBy vp3Scroll 1 >> M.continue ()
|
||||
@ -71,7 +67,7 @@ appEvent _ (V.EvKey V.KLeft []) = M.hScrollBy vp2Scroll (-1) >> M.continue ()
|
||||
appEvent _ (V.EvKey V.KEsc []) = M.halt ()
|
||||
appEvent _ _ = M.continue ()
|
||||
|
||||
app :: M.App () V.Event
|
||||
app :: M.App () V.Event Name
|
||||
app =
|
||||
M.App { M.appDraw = drawUi
|
||||
, M.appStartEvent = return
|
||||
|
||||
@ -36,28 +36,24 @@ data St =
|
||||
|
||||
makeLenses ''St
|
||||
|
||||
vp1Name :: T.Name
|
||||
vp1Name = "demo1"
|
||||
data Name = VP1
|
||||
| VP2
|
||||
| VP3
|
||||
deriving (Show, Ord, Eq)
|
||||
|
||||
vp1Size :: Int
|
||||
vp1Size = 15
|
||||
|
||||
vp2Name :: T.Name
|
||||
vp2Name = "demo2"
|
||||
|
||||
vp2Size :: Int
|
||||
vp2Size = 15
|
||||
|
||||
vp3Name :: T.Name
|
||||
vp3Name = "demo3"
|
||||
|
||||
vp3Size :: (Int, Int)
|
||||
vp3Size = (25, 25)
|
||||
|
||||
selectedAttr :: AttrName
|
||||
selectedAttr = "selected"
|
||||
|
||||
drawUi :: St -> [Widget]
|
||||
drawUi :: St -> [Widget Name]
|
||||
drawUi st = [ui]
|
||||
where
|
||||
ui = C.center $ hLimit 60 $ vLimit 30 $
|
||||
@ -66,7 +62,7 @@ drawUi st = [ui]
|
||||
"- Left/right arrow keys scroll the top-right viewport\n" <>
|
||||
"- Ctrl-arrow keys move the bottom viewport"
|
||||
]
|
||||
singleton = viewport vp3Name Both $
|
||||
singleton = viewport VP3 Both $
|
||||
vBox $ do
|
||||
i <- [1..vp3Size^._1]
|
||||
let row = do
|
||||
@ -78,14 +74,14 @@ drawUi st = [ui]
|
||||
return $ hBox row
|
||||
|
||||
pair = hBox [ vp1, B.vBorder, vp2 ]
|
||||
vp1 = viewport vp1Name Vertical $
|
||||
vp1 = viewport VP1 Vertical $
|
||||
vBox $ do
|
||||
i <- [1..vp1Size]
|
||||
let mkItem = if i == st^.vp1Index
|
||||
then withAttr selectedAttr . visible
|
||||
else id
|
||||
return $ mkItem $ str $ "Item " <> show i
|
||||
vp2 = viewport vp2Name Horizontal $
|
||||
vp2 = viewport VP2 Horizontal $
|
||||
hBox $ do
|
||||
i <- [1..vp2Size]
|
||||
let mkItem = if i == st^.vp2Index
|
||||
@ -93,16 +89,16 @@ drawUi st = [ui]
|
||||
else id
|
||||
return $ mkItem $ str $ "Item " <> show i <> " "
|
||||
|
||||
vp1Scroll :: M.ViewportScroll
|
||||
vp1Scroll = M.viewportScroll vp1Name
|
||||
vp1Scroll :: M.ViewportScroll Name
|
||||
vp1Scroll = M.viewportScroll VP1
|
||||
|
||||
vp2Scroll :: M.ViewportScroll
|
||||
vp2Scroll = M.viewportScroll vp2Name
|
||||
vp2Scroll :: M.ViewportScroll Name
|
||||
vp2Scroll = M.viewportScroll VP2
|
||||
|
||||
vp3Scroll :: M.ViewportScroll
|
||||
vp3Scroll = M.viewportScroll vp3Name
|
||||
vp3Scroll :: M.ViewportScroll Name
|
||||
vp3Scroll = M.viewportScroll VP3
|
||||
|
||||
appEvent :: St -> V.Event -> T.EventM (T.Next St)
|
||||
appEvent :: St -> V.Event -> T.EventM Name (T.Next St)
|
||||
appEvent st (V.EvKey V.KDown [V.MCtrl]) = M.continue $ st & vp3Index._1 %~ min (vp3Size^._1) . (+ 1)
|
||||
appEvent st (V.EvKey V.KUp [V.MCtrl]) = M.continue $ st & vp3Index._1 %~ max 1 . subtract 1
|
||||
appEvent st (V.EvKey V.KRight [V.MCtrl]) = M.continue $ st & vp3Index._2 %~ min (vp3Size^._1) . (+ 1)
|
||||
@ -119,7 +115,7 @@ theMap = attrMap V.defAttr
|
||||
[ (selectedAttr, V.black `on` V.yellow)
|
||||
]
|
||||
|
||||
app :: M.App St V.Event
|
||||
app :: M.App St V.Event Name
|
||||
app =
|
||||
M.App { M.appDraw = drawUi
|
||||
, M.appStartEvent = return
|
||||
|
||||
@ -21,23 +21,23 @@ import Brick.Types
|
||||
|
||||
-- | A focus ring containing a sequence of widget names to focus and a
|
||||
-- currently-focused widget name.
|
||||
data FocusRing = FocusRingEmpty
|
||||
| FocusRingNonempty ![Name] !Int
|
||||
data FocusRing n = FocusRingEmpty
|
||||
| FocusRingNonempty ![n] !Int
|
||||
|
||||
-- | Construct a focus ring from the list of names.
|
||||
focusRing :: [Name] -> FocusRing
|
||||
focusRing :: [n] -> FocusRing n
|
||||
focusRing [] = FocusRingEmpty
|
||||
focusRing names = FocusRingNonempty names 0
|
||||
|
||||
-- | Advance focus to the next widget in the ring.
|
||||
focusNext :: FocusRing -> FocusRing
|
||||
focusNext :: FocusRing n -> FocusRing n
|
||||
focusNext FocusRingEmpty = FocusRingEmpty
|
||||
focusNext (FocusRingNonempty ns i) = FocusRingNonempty ns i'
|
||||
where
|
||||
i' = (i + 1) `mod` (length ns)
|
||||
|
||||
-- | Advance focus to the previous widget in the ring.
|
||||
focusPrev :: FocusRing -> FocusRing
|
||||
focusPrev :: FocusRing n -> FocusRing n
|
||||
focusPrev FocusRingEmpty = FocusRingEmpty
|
||||
focusPrev (FocusRingNonempty ns i) = FocusRingNonempty ns i'
|
||||
where
|
||||
@ -45,20 +45,21 @@ focusPrev (FocusRingNonempty ns i) = FocusRingNonempty ns i'
|
||||
|
||||
-- | Get the currently-focused widget name from the ring. If the ring is
|
||||
-- emtpy, return 'Nothing'.
|
||||
focusGetCurrent :: FocusRing -> Maybe Name
|
||||
focusGetCurrent :: FocusRing n -> Maybe n
|
||||
focusGetCurrent FocusRingEmpty = Nothing
|
||||
focusGetCurrent (FocusRingNonempty ns i) = Just $ ns !! i
|
||||
|
||||
-- | Cursor selection convenience function for use as an
|
||||
-- 'Brick.Main.appChooseCursor' value.
|
||||
focusRingCursor :: (a -> FocusRing)
|
||||
focusRingCursor :: (Eq n)
|
||||
=> (a -> FocusRing n)
|
||||
-- ^ The function used to get the focus ring out of your
|
||||
-- application state.
|
||||
-> a
|
||||
-- ^ Your application state.
|
||||
-> [CursorLocation]
|
||||
-> [CursorLocation n]
|
||||
-- ^ The list of available cursor positions.
|
||||
-> Maybe CursorLocation
|
||||
-> Maybe (CursorLocation n)
|
||||
-- ^ The cursor position, if any, that matches the name
|
||||
-- currently focused by the 'FocusRing'.
|
||||
focusRingCursor getRing st ls =
|
||||
|
||||
@ -53,7 +53,7 @@ import Graphics.Vty
|
||||
, mkVty
|
||||
)
|
||||
|
||||
import Brick.Types (Viewport, Direction, Widget, rowL, columnL, CursorLocation(..), cursorLocationNameL, Name(..), EventM(..))
|
||||
import Brick.Types (Viewport, Direction, Widget, rowL, columnL, CursorLocation(..), cursorLocationNameL, EventM(..))
|
||||
import Brick.Types.Internal (ScrollRequest(..), RenderState(..), Next(..))
|
||||
import Brick.Widgets.Internal (renderFinal)
|
||||
import Brick.AttrMap
|
||||
@ -65,11 +65,11 @@ import Brick.AttrMap
|
||||
-- vty's 'Event' type, but you may define your own event type, permitted
|
||||
-- that it has a constructor for wrapping Vty events, so that Vty events
|
||||
-- can be handled by your event loop.
|
||||
data App s e =
|
||||
App { appDraw :: s -> [Widget]
|
||||
data App s e n =
|
||||
App { appDraw :: s -> [Widget n]
|
||||
-- ^ This function turns your application state into a list of
|
||||
-- widget layers. The layers are listed topmost first.
|
||||
, appChooseCursor :: s -> [CursorLocation] -> Maybe CursorLocation
|
||||
, appChooseCursor :: s -> [CursorLocation n] -> Maybe (CursorLocation n)
|
||||
-- ^ This function chooses which of the zero or more cursor
|
||||
-- locations reported by the rendering process should be
|
||||
-- selected as the one to use to place the cursor. If this
|
||||
@ -77,12 +77,12 @@ data App s e =
|
||||
-- is that many widgets may request a cursor placement but your
|
||||
-- application state is what you probably want to use to decide
|
||||
-- which one wins.
|
||||
, appHandleEvent :: s -> e -> EventM (Next s)
|
||||
, appHandleEvent :: s -> e -> EventM n (Next s)
|
||||
-- ^ This function takes the current application state and an
|
||||
-- event and returns an action to be taken and a corresponding
|
||||
-- transformed application state. Possible options are
|
||||
-- 'continue', 'suspendAndResume', and 'halt'.
|
||||
, appStartEvent :: s -> EventM s
|
||||
, appStartEvent :: s -> EventM n s
|
||||
-- ^ This function gets called once just prior to the first
|
||||
-- drawing of your application. Here is where you can make
|
||||
-- initial scrolling requests, for example.
|
||||
@ -97,7 +97,7 @@ data App s e =
|
||||
-- | The default main entry point which takes an application and an
|
||||
-- initial state and returns the final state returned by a 'halt'
|
||||
-- operation.
|
||||
defaultMain :: App s Event
|
||||
defaultMain :: App s Event n
|
||||
-- ^ The application.
|
||||
-> s
|
||||
-- ^ The initial application state.
|
||||
@ -109,7 +109,7 @@ defaultMain app st = do
|
||||
-- | A simple main entry point which takes a widget and renders it. This
|
||||
-- event loop terminates when the user presses any key, but terminal
|
||||
-- resize events cause redraws.
|
||||
simpleMain :: Widget
|
||||
simpleMain :: Widget n
|
||||
-- ^ The widget to draw.
|
||||
-> IO ()
|
||||
simpleMain w =
|
||||
@ -127,14 +127,14 @@ simpleMain w =
|
||||
-- a halt. This is a convenience function useful as an 'appHandleEvent'
|
||||
-- value for simple applications using the 'Event' type that do not need
|
||||
-- to get more sophisticated user input.
|
||||
resizeOrQuit :: s -> Event -> EventM (Next s)
|
||||
resizeOrQuit :: s -> Event -> EventM n (Next s)
|
||||
resizeOrQuit s (EvResize _ _) = continue s
|
||||
resizeOrQuit s _ = halt s
|
||||
|
||||
data InternalNext a = InternalSuspendAndResume RenderState (IO a)
|
||||
| InternalHalt a
|
||||
data InternalNext n a = InternalSuspendAndResume (RenderState n) (IO a)
|
||||
| InternalHalt a
|
||||
|
||||
runWithNewVty :: IO Vty -> Chan e -> App s e -> RenderState -> s -> IO (InternalNext s)
|
||||
runWithNewVty :: IO Vty -> Chan e -> App s e n -> RenderState n -> s -> IO (InternalNext n s)
|
||||
runWithNewVty buildVty chan app initialRS initialSt =
|
||||
withVty buildVty $ \vty -> do
|
||||
pid <- forkIO $ supplyVtyEvents vty (appLiftVtyEvent app) chan
|
||||
@ -160,7 +160,7 @@ customMain :: IO Vty
|
||||
-- ^ An event channel for sending custom events to the event
|
||||
-- loop (you write to this channel, the event loop reads from
|
||||
-- it).
|
||||
-> App s e
|
||||
-> App s e n
|
||||
-- ^ The application.
|
||||
-> s
|
||||
-- ^ The initial application state.
|
||||
@ -184,7 +184,7 @@ supplyVtyEvents vty mkEvent chan =
|
||||
e <- nextEvent vty
|
||||
writeChan chan $ mkEvent e
|
||||
|
||||
runVty :: Vty -> Chan e -> App s e -> s -> RenderState -> IO (Next s, RenderState)
|
||||
runVty :: Vty -> Chan e -> App s e n -> s -> RenderState n -> IO (Next s, RenderState n)
|
||||
runVty vty chan app appState rs = do
|
||||
firstRS <- renderApp vty app appState rs
|
||||
e <- readChan chan
|
||||
@ -196,7 +196,7 @@ runVty vty chan app appState rs = do
|
||||
-- no such state could be found, either because the name was invalid
|
||||
-- or because no rendering has occurred (e.g. in an 'appStartEvent'
|
||||
-- handler).
|
||||
lookupViewport :: Name -> EventM (Maybe Viewport)
|
||||
lookupViewport :: (Ord n) => n -> EventM n (Maybe Viewport)
|
||||
lookupViewport = EventM . asks . M.lookup
|
||||
|
||||
withVty :: IO Vty -> (Vty -> IO a) -> IO a
|
||||
@ -204,7 +204,7 @@ withVty buildVty useVty = do
|
||||
vty <- buildVty
|
||||
useVty vty `finally` shutdown vty
|
||||
|
||||
renderApp :: Vty -> App s e -> s -> RenderState -> IO RenderState
|
||||
renderApp :: Vty -> App s e n -> s -> RenderState n -> IO (RenderState n)
|
||||
renderApp vty app appState rs = do
|
||||
sz <- displayBounds $ outputIface vty
|
||||
let (newRS, pic, theCursor) = renderFinal (appAttrMap app appState)
|
||||
@ -224,56 +224,56 @@ renderApp vty app appState rs = do
|
||||
-- process. This is a convenience function useful as an
|
||||
-- 'appChooseCursor' value when a simple application has no need to
|
||||
-- position the cursor.
|
||||
neverShowCursor :: s -> [CursorLocation] -> Maybe CursorLocation
|
||||
neverShowCursor :: s -> [CursorLocation n] -> Maybe (CursorLocation n)
|
||||
neverShowCursor = const $ const Nothing
|
||||
|
||||
-- | Always show the first cursor, if any, returned by the rendering
|
||||
-- process. This is a convenience function useful as an
|
||||
-- 'appChooseCursor' value when a simple program has zero or more
|
||||
-- widgets that advertise a cursor position.
|
||||
showFirstCursor :: s -> [CursorLocation] -> Maybe CursorLocation
|
||||
showFirstCursor :: s -> [CursorLocation n] -> Maybe (CursorLocation n)
|
||||
showFirstCursor = const listToMaybe
|
||||
|
||||
-- | Show the cursor with the specified name, if such a cursor location
|
||||
-- has been reported.
|
||||
showCursorNamed :: Name -> [CursorLocation] -> Maybe CursorLocation
|
||||
showCursorNamed :: (Eq n) => n -> [CursorLocation n] -> Maybe (CursorLocation n)
|
||||
showCursorNamed name locs =
|
||||
let matches loc = loc^.cursorLocationNameL == Just name
|
||||
in listToMaybe $ filter matches locs
|
||||
|
||||
-- | A viewport scrolling handle for managing the scroll state of
|
||||
-- viewports.
|
||||
data ViewportScroll =
|
||||
ViewportScroll { viewportName :: Name
|
||||
data ViewportScroll n =
|
||||
ViewportScroll { viewportName :: n
|
||||
-- ^ The name of the viewport to be controlled by
|
||||
-- this scrolling handle.
|
||||
, hScrollPage :: Direction -> EventM ()
|
||||
, hScrollPage :: Direction -> EventM n ()
|
||||
-- ^ Scroll the viewport horizontally by one page in
|
||||
-- the specified direction.
|
||||
, hScrollBy :: Int -> EventM ()
|
||||
, hScrollBy :: Int -> EventM n ()
|
||||
-- ^ Scroll the viewport horizontally by the
|
||||
-- specified number of rows or columns depending on
|
||||
-- the orientation of the viewport.
|
||||
, hScrollToBeginning :: EventM ()
|
||||
, hScrollToBeginning :: EventM n ()
|
||||
-- ^ Scroll horizontally to the beginning of the
|
||||
-- viewport.
|
||||
, hScrollToEnd :: EventM ()
|
||||
, hScrollToEnd :: EventM n ()
|
||||
-- ^ Scroll horizontally to the end of the viewport.
|
||||
, vScrollPage :: Direction -> EventM ()
|
||||
, vScrollPage :: Direction -> EventM n ()
|
||||
-- ^ Scroll the viewport vertically by one page in
|
||||
-- the specified direction.
|
||||
, vScrollBy :: Int -> EventM ()
|
||||
, vScrollBy :: Int -> EventM n ()
|
||||
-- ^ Scroll the viewport vertically by the specified
|
||||
-- number of rows or columns depending on the
|
||||
-- orientation of the viewport.
|
||||
, vScrollToBeginning :: EventM ()
|
||||
, vScrollToBeginning :: EventM n ()
|
||||
-- ^ Scroll vertically to the beginning of the viewport.
|
||||
, vScrollToEnd :: EventM ()
|
||||
, vScrollToEnd :: EventM n ()
|
||||
-- ^ Scroll vertically to the end of the viewport.
|
||||
}
|
||||
|
||||
-- | Build a viewport scroller for the viewport with the specified name.
|
||||
viewportScroll :: Name -> ViewportScroll
|
||||
viewportScroll :: n -> ViewportScroll n
|
||||
viewportScroll n =
|
||||
ViewportScroll { viewportName = n
|
||||
, hScrollPage = \dir -> EventM $ lift $ modify ((n, HScrollPage dir) :)
|
||||
@ -288,17 +288,17 @@ viewportScroll n =
|
||||
|
||||
-- | Continue running the event loop with the specified application
|
||||
-- state.
|
||||
continue :: s -> EventM (Next s)
|
||||
continue :: s -> EventM n (Next s)
|
||||
continue = return . Continue
|
||||
|
||||
-- | Halt the event loop and return the specified application state as
|
||||
-- the final state value.
|
||||
halt :: s -> EventM (Next s)
|
||||
halt :: s -> EventM n (Next s)
|
||||
halt = return . Halt
|
||||
|
||||
-- | Suspend the event loop, save the terminal state, and run the
|
||||
-- specified action. When it returns an application state value, restore
|
||||
-- the terminal state, redraw the application from the new state, and
|
||||
-- resume the event loop.
|
||||
suspendAndResume :: IO s -> EventM (Next s)
|
||||
suspendAndResume :: IO s -> EventM n (Next s)
|
||||
suspendAndResume = return . SuspendAndResume
|
||||
|
||||
@ -26,7 +26,7 @@ import Brick.Types
|
||||
-- rendering monad. You probably won't need to instance this.
|
||||
class GetAttr a where
|
||||
-- | Where to get the attribute for this attribute metadata.
|
||||
getAttr :: a -> RenderM Attr
|
||||
getAttr :: a -> RenderM n Attr
|
||||
|
||||
instance GetAttr Attr where
|
||||
getAttr a = do
|
||||
@ -44,7 +44,7 @@ instance GetAttr AttrName where
|
||||
(@?) = (@@)
|
||||
|
||||
-- | Build a widget from markup.
|
||||
markup :: (Eq a, GetAttr a) => Markup a -> Widget
|
||||
markup :: (Eq a, GetAttr a) => Markup a -> Widget n
|
||||
markup m =
|
||||
Widget Fixed Fixed $ do
|
||||
let markupLines = markupToList m
|
||||
|
||||
@ -25,7 +25,6 @@ module Brick.Types
|
||||
-- * Event-handling types
|
||||
, EventM(..)
|
||||
, Next
|
||||
, HandleEvent(..)
|
||||
, handleEventLensed
|
||||
|
||||
-- * Rendering infrastructure
|
||||
@ -62,7 +61,6 @@ module Brick.Types
|
||||
, Size(..)
|
||||
, Padding(..)
|
||||
, Direction(..)
|
||||
, Name(..)
|
||||
|
||||
)
|
||||
where
|
||||
@ -89,34 +87,30 @@ data Padding = Pad Int
|
||||
| Max
|
||||
-- ^ Pad up to the number of available rows or columns.
|
||||
|
||||
-- | The class of types that provide some basic event-handling.
|
||||
class HandleEvent a where
|
||||
-- | Handle a Vty event
|
||||
handleEvent :: Event -> a -> EventM a
|
||||
|
||||
-- | A convenience function for handling events intended for values
|
||||
-- that are targets of lenses in your application state. This function
|
||||
-- obtains the target value of the specified lens, invokes 'handleEvent'
|
||||
-- on it, and stores the resulting transformed value back in the state
|
||||
-- using the lens.
|
||||
handleEventLensed :: (HandleEvent b)
|
||||
=> a
|
||||
handleEventLensed :: a
|
||||
-- ^ The state value.
|
||||
-> Lens' a b
|
||||
-- ^ The lens to use to extract and store the target
|
||||
-- of the event.
|
||||
-> (Event -> b -> EventM n b)
|
||||
-- ^ The event handler.
|
||||
-> Event
|
||||
-- ^ The event to handle.
|
||||
-> EventM a
|
||||
handleEventLensed v target ev = do
|
||||
-> EventM n a
|
||||
handleEventLensed v target handleEvent ev = do
|
||||
newB <- handleEvent ev (v^.target)
|
||||
return $ v & target .~ newB
|
||||
|
||||
-- | The monad in which event handlers run. Although it may be tempting
|
||||
-- to dig into the reader value yourself, just use
|
||||
-- 'Brick.Main.lookupViewport'.
|
||||
newtype EventM a =
|
||||
EventM { runEventM :: ReaderT (M.Map Name Viewport) (StateT EventState IO) a
|
||||
newtype EventM n a =
|
||||
EventM { runEventM :: ReaderT (M.Map n Viewport) (StateT (EventState n) IO) a
|
||||
}
|
||||
deriving (Functor, Applicative, Monad, MonadIO)
|
||||
|
||||
@ -132,27 +126,27 @@ data Size = Fixed
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
-- | The type of widgets.
|
||||
data Widget =
|
||||
data Widget n =
|
||||
Widget { hSize :: Size
|
||||
-- ^ This widget's horizontal growth policy
|
||||
, vSize :: Size
|
||||
-- ^ This widget's vertical growth policy
|
||||
, render :: RenderM Result
|
||||
, render :: RenderM n (Result n)
|
||||
-- ^ This widget's rendering function
|
||||
}
|
||||
|
||||
-- | The type of the rendering monad. This monad is used by the
|
||||
-- library's rendering routines to manage rendering state and
|
||||
-- communicate rendering parameters to widgets' rendering functions.
|
||||
type RenderM a = ReaderT Context (State RenderState) a
|
||||
type RenderM n a = ReaderT Context (State (RenderState n)) a
|
||||
|
||||
-- | The type of result returned by a widget's rendering function. The
|
||||
-- result provides the image, cursor positions, and visibility requests
|
||||
-- that resulted from the rendering process.
|
||||
data Result =
|
||||
data Result n =
|
||||
Result { image :: Image
|
||||
-- ^ The final rendered image for a widget
|
||||
, cursors :: [CursorLocation]
|
||||
, cursors :: [CursorLocation n]
|
||||
-- ^ The list of reported cursor positions for the
|
||||
-- application to choose from
|
||||
, visibilityRequests :: [VisibilityRequest]
|
||||
@ -161,11 +155,11 @@ data Result =
|
||||
}
|
||||
deriving Show
|
||||
|
||||
instance Default Result where
|
||||
instance Default (Result n) where
|
||||
def = Result emptyImage [] []
|
||||
|
||||
-- | Get the current rendering context.
|
||||
getContext :: RenderM Context
|
||||
getContext :: RenderM n Context
|
||||
getContext = ask
|
||||
|
||||
suffixLenses ''Context
|
||||
@ -175,7 +169,7 @@ suffixLenses ''Result
|
||||
attrL :: (Contravariant f, Functor f) => (Attr -> f Attr) -> Context -> f Context
|
||||
attrL = to (\c -> attrMapLookup (c^.ctxAttrNameL) (c^.ctxAttrMapL))
|
||||
|
||||
instance TerminalLocation CursorLocation where
|
||||
instance TerminalLocation (CursorLocation n) where
|
||||
columnL = cursorLocationL._1
|
||||
column = column . cursorLocation
|
||||
rowL = cursorLocationL._2
|
||||
@ -183,7 +177,7 @@ instance TerminalLocation CursorLocation where
|
||||
|
||||
-- | Given an attribute name, obtain the attribute for the attribute
|
||||
-- name by consulting the context's attribute map.
|
||||
lookupAttrName :: AttrName -> RenderM Attr
|
||||
lookupAttrName :: AttrName -> RenderM n Attr
|
||||
lookupAttrName n = do
|
||||
c <- getContext
|
||||
return $ attrMapLookup n (c^.ctxAttrMapL)
|
||||
|
||||
@ -5,7 +5,6 @@ module Brick.Types.Internal
|
||||
, VisibilityRequest(..)
|
||||
, vrPositionL
|
||||
, vrSizeL
|
||||
, Name(..)
|
||||
, Location(..)
|
||||
, locL
|
||||
, origin
|
||||
@ -39,17 +38,9 @@ import Brick.Types.TH
|
||||
import Brick.AttrMap (AttrName, AttrMap)
|
||||
import Brick.Widgets.Border.Style (BorderStyle)
|
||||
|
||||
-- | Names of things. Used to name cursor locations, widgets, and
|
||||
-- viewports.
|
||||
newtype Name = Name String
|
||||
deriving (Eq, Show, Ord)
|
||||
|
||||
instance IsString Name where
|
||||
fromString = Name
|
||||
|
||||
data RenderState =
|
||||
RS { viewportMap :: M.Map Name Viewport
|
||||
, scrollRequests :: [(Name, ScrollRequest)]
|
||||
data RenderState n =
|
||||
RS { viewportMap :: M.Map n Viewport
|
||||
, scrollRequests :: [(n, ScrollRequest)]
|
||||
}
|
||||
|
||||
data ScrollRequest = HScrollBy Int
|
||||
@ -89,7 +80,7 @@ data ViewportType = Vertical
|
||||
-- ^ Viewports of this type are scrollable vertically and horizontally.
|
||||
deriving Show
|
||||
|
||||
type EventState = [(Name, ScrollRequest)]
|
||||
type EventState n = [(n, ScrollRequest)]
|
||||
|
||||
-- | The type of actions to take upon completion of an event handler.
|
||||
data Next a = Continue a
|
||||
@ -140,10 +131,10 @@ instance Monoid Location where
|
||||
mappend (Location (w1, h1)) (Location (w2, h2)) = Location (w1+w2, h1+h2)
|
||||
|
||||
-- | A cursor location. These are returned by the rendering process.
|
||||
data CursorLocation =
|
||||
data CursorLocation n =
|
||||
CursorLocation { cursorLocation :: !Location
|
||||
-- ^ The location
|
||||
, cursorLocationName :: !(Maybe Name)
|
||||
, cursorLocationName :: !(Maybe n)
|
||||
-- ^ The name of the widget associated with the location
|
||||
}
|
||||
deriving Show
|
||||
|
||||
@ -55,5 +55,5 @@ bg :: Color -> Attr
|
||||
bg = (defAttr `withBackColor`)
|
||||
|
||||
-- | Add a 'Location' offset to the specified 'CursorLocation'.
|
||||
clOffset :: CursorLocation -> Location -> CursorLocation
|
||||
clOffset :: CursorLocation n -> Location -> CursorLocation n
|
||||
clOffset cl off = cl & cursorLocationL %~ (<> off)
|
||||
|
||||
@ -75,26 +75,26 @@ brCornerAttr = borderAttr <> "corner" <> "br"
|
||||
|
||||
-- | Draw the specified border element using the active border style
|
||||
-- using 'borderAttr'.
|
||||
borderElem :: (BorderStyle -> Char) -> Widget
|
||||
borderElem :: (BorderStyle -> Char) -> Widget n
|
||||
borderElem f =
|
||||
Widget Fixed Fixed $ do
|
||||
bs <- ctxBorderStyle <$> getContext
|
||||
render $ withAttr borderAttr $ str [f bs]
|
||||
|
||||
-- | Put a border around the specified widget.
|
||||
border :: Widget -> Widget
|
||||
border :: Widget n -> Widget n
|
||||
border = border_ Nothing
|
||||
|
||||
-- | Put a border around the specified widget with the specified label
|
||||
-- widget placed in the middle of the top horizontal border.
|
||||
borderWithLabel :: Widget
|
||||
borderWithLabel :: Widget n
|
||||
-- ^ The label widget
|
||||
-> Widget
|
||||
-> Widget n
|
||||
-- ^ The widget to put a border around
|
||||
-> Widget
|
||||
-> Widget n
|
||||
borderWithLabel label = border_ (Just label)
|
||||
|
||||
border_ :: Maybe Widget -> Widget -> Widget
|
||||
border_ :: Maybe (Widget n) -> Widget n -> Widget n
|
||||
border_ label wrapped =
|
||||
Widget (hSize wrapped) (vSize wrapped) $ do
|
||||
bs <- ctxBorderStyle <$> getContext
|
||||
@ -118,17 +118,17 @@ border_ label wrapped =
|
||||
$ total
|
||||
|
||||
-- | A horizontal border. Fills all horizontal space.
|
||||
hBorder :: Widget
|
||||
hBorder :: Widget n
|
||||
hBorder = hBorder_ Nothing
|
||||
|
||||
-- | A horizontal border with a label placed in the center of the
|
||||
-- border. Fills all horizontal space.
|
||||
hBorderWithLabel :: Widget
|
||||
hBorderWithLabel :: Widget n
|
||||
-- ^ The label widget
|
||||
-> Widget
|
||||
-> Widget n
|
||||
hBorderWithLabel label = hBorder_ (Just label)
|
||||
|
||||
hBorder_ :: Maybe Widget -> Widget
|
||||
hBorder_ :: Maybe (Widget n) -> Widget n
|
||||
hBorder_ label =
|
||||
Widget Greedy Fixed $ do
|
||||
bs <- ctxBorderStyle <$> getContext
|
||||
@ -136,7 +136,7 @@ hBorder_ label =
|
||||
render $ vLimit 1 $ withAttr hBorderAttr $ hCenterWith (Just $ bsHorizontal bs) msg
|
||||
|
||||
-- | A vertical border. Fills all vertical space.
|
||||
vBorder :: Widget
|
||||
vBorder :: Widget n
|
||||
vBorder =
|
||||
Widget Fixed Greedy $ do
|
||||
bs <- ctxBorderStyle <$> getContext
|
||||
|
||||
@ -23,13 +23,13 @@ import Brick.Widgets.Core
|
||||
|
||||
-- | Center the specified widget horizontally. Consumes all available
|
||||
-- horizontal space.
|
||||
hCenter :: Widget -> Widget
|
||||
hCenter :: Widget n -> Widget n
|
||||
hCenter = hCenterWith Nothing
|
||||
|
||||
-- | Center the specified widget horizontally. Consumes all available
|
||||
-- horizontal space. Uses the specified character to fill in the space
|
||||
-- to either side of the centered widget (defaults to space).
|
||||
hCenterWith :: Maybe Char -> Widget -> Widget
|
||||
hCenterWith :: Maybe Char -> Widget n -> Widget n
|
||||
hCenterWith mChar p =
|
||||
let ch = fromMaybe ' ' mChar
|
||||
in Widget Greedy (vSize p) $ do
|
||||
@ -53,13 +53,13 @@ hCenterWith mChar p =
|
||||
$ result & imageL .~ paddedImage
|
||||
|
||||
-- | Center a widget vertically. Consumes all vertical space.
|
||||
vCenter :: Widget -> Widget
|
||||
vCenter :: Widget n -> Widget n
|
||||
vCenter = vCenterWith Nothing
|
||||
|
||||
-- | Center a widget vertically. Consumes all vertical space. Uses the
|
||||
-- specified character to fill in the space above and below the centered
|
||||
-- widget (defaults to space).
|
||||
vCenterWith :: Maybe Char -> Widget -> Widget
|
||||
vCenterWith :: Maybe Char -> Widget n -> Widget n
|
||||
vCenterWith mChar p =
|
||||
let ch = fromMaybe ' ' mChar
|
||||
in Widget (hSize p) Greedy $ do
|
||||
@ -84,18 +84,18 @@ vCenterWith mChar p =
|
||||
|
||||
-- | Center a widget both vertically and horizontally. Consumes all
|
||||
-- available vertical and horizontal space.
|
||||
center :: Widget -> Widget
|
||||
center :: Widget n -> Widget n
|
||||
center = centerWith Nothing
|
||||
|
||||
-- | Center a widget both vertically and horizontally. Consumes all
|
||||
-- available vertical and horizontal space. Uses the specified character
|
||||
-- to fill in the space around the centered widget (defaults to space).
|
||||
centerWith :: Maybe Char -> Widget -> Widget
|
||||
centerWith :: Maybe Char -> Widget n -> Widget n
|
||||
centerWith c = vCenterWith c . hCenterWith c
|
||||
|
||||
-- | Center the widget horizontally and vertically about the specified
|
||||
-- origin.
|
||||
centerAbout :: Location -> Widget -> Widget
|
||||
centerAbout :: Location -> Widget n -> Widget n
|
||||
centerAbout l p =
|
||||
Widget Greedy Greedy $ do
|
||||
-- Compute translation offset so that loc is in the middle of the
|
||||
|
||||
@ -89,11 +89,11 @@ import Brick.Widgets.Internal
|
||||
|
||||
-- | When rendering the specified widget, use the specified border style
|
||||
-- for any border rendering.
|
||||
withBorderStyle :: BorderStyle -> Widget -> Widget
|
||||
withBorderStyle :: BorderStyle -> Widget n -> Widget n
|
||||
withBorderStyle bs p = Widget (hSize p) (vSize p) $ withReaderT (& ctxBorderStyleL .~ bs) (render p)
|
||||
|
||||
-- | The empty widget.
|
||||
emptyWidget :: Widget
|
||||
emptyWidget :: Widget n
|
||||
emptyWidget = raw V.emptyImage
|
||||
|
||||
-- | Add an offset to all cursor locations and visbility requests
|
||||
@ -105,13 +105,13 @@ emptyWidget = raw V.emptyImage
|
||||
-- by other combinators. You should call this any time you render
|
||||
-- something and then translate it or otherwise offset it from its
|
||||
-- original origin.
|
||||
addResultOffset :: Location -> Result -> Result
|
||||
addResultOffset :: Location -> Result n -> Result n
|
||||
addResultOffset off = addCursorOffset off . addVisibilityOffset off
|
||||
|
||||
addVisibilityOffset :: Location -> Result -> Result
|
||||
addVisibilityOffset :: Location -> Result n -> Result n
|
||||
addVisibilityOffset off r = r & visibilityRequestsL.each.vrPositionL %~ (off <>)
|
||||
|
||||
addCursorOffset :: Location -> Result -> Result
|
||||
addCursorOffset :: Location -> Result n -> Result n
|
||||
addCursorOffset off r =
|
||||
let onlyVisible = filter isVisible
|
||||
isVisible l = l^.columnL >= 0 && l^.rowL >= 0
|
||||
@ -122,7 +122,7 @@ unrestricted = 100000
|
||||
|
||||
-- | Build a widget from a 'String'. Breaks newlines up and space-pads
|
||||
-- short lines out to the length of the longest line.
|
||||
str :: String -> Widget
|
||||
str :: String -> Widget n
|
||||
str s =
|
||||
Widget Fixed Fixed $ do
|
||||
c <- getContext
|
||||
@ -141,13 +141,13 @@ str s =
|
||||
|
||||
-- | Build a widget from a one-line 'T.Text' value. Behaves the same as
|
||||
-- 'str'.
|
||||
txt :: T.Text -> Widget
|
||||
txt :: T.Text -> Widget n
|
||||
txt = str . T.unpack
|
||||
|
||||
-- | Pad the specified widget on the left. If max padding is used, this
|
||||
-- grows greedily horizontally; otherwise it defers to the padded
|
||||
-- widget.
|
||||
padLeft :: Padding -> Widget -> Widget
|
||||
padLeft :: Padding -> Widget n -> Widget n
|
||||
padLeft padding p =
|
||||
let (f, sz) = case padding of
|
||||
Max -> (id, Greedy)
|
||||
@ -164,7 +164,7 @@ padLeft padding p =
|
||||
-- | Pad the specified widget on the right. If max padding is used,
|
||||
-- this grows greedily horizontally; otherwise it defers to the padded
|
||||
-- widget.
|
||||
padRight :: Padding -> Widget -> Widget
|
||||
padRight :: Padding -> Widget n -> Widget n
|
||||
padRight padding p =
|
||||
let (f, sz) = case padding of
|
||||
Max -> (id, Greedy)
|
||||
@ -180,7 +180,7 @@ padRight padding p =
|
||||
|
||||
-- | Pad the specified widget on the top. If max padding is used, this
|
||||
-- grows greedily vertically; otherwise it defers to the padded widget.
|
||||
padTop :: Padding -> Widget -> Widget
|
||||
padTop :: Padding -> Widget n -> Widget n
|
||||
padTop padding p =
|
||||
let (f, sz) = case padding of
|
||||
Max -> (id, Greedy)
|
||||
@ -197,7 +197,7 @@ padTop padding p =
|
||||
-- | Pad the specified widget on the bottom. If max padding is used,
|
||||
-- this grows greedily vertically; otherwise it defers to the padded
|
||||
-- widget.
|
||||
padBottom :: Padding -> Widget -> Widget
|
||||
padBottom :: Padding -> Widget n -> Widget n
|
||||
padBottom padding p =
|
||||
let (f, sz) = case padding of
|
||||
Max -> (id, Greedy)
|
||||
@ -213,22 +213,22 @@ padBottom padding p =
|
||||
|
||||
-- | Pad a widget on the left and right. Defers to the padded widget for
|
||||
-- growth policy.
|
||||
padLeftRight :: Int -> Widget -> Widget
|
||||
padLeftRight :: Int -> Widget n -> Widget n
|
||||
padLeftRight c w = padLeft (Pad c) $ padRight (Pad c) w
|
||||
|
||||
-- | Pad a widget on the top and bottom. Defers to the padded widget for
|
||||
-- growth policy.
|
||||
padTopBottom :: Int -> Widget -> Widget
|
||||
padTopBottom :: Int -> Widget n -> Widget n
|
||||
padTopBottom r w = padTop (Pad r) $ padBottom (Pad r) w
|
||||
|
||||
-- | Pad a widget on all sides. Defers to the padded widget for growth
|
||||
-- policy.
|
||||
padAll :: Int -> Widget -> Widget
|
||||
padAll :: Int -> Widget n -> Widget n
|
||||
padAll v w = padLeftRight v $ padTopBottom v w
|
||||
|
||||
-- | Fill all available space with the specified character. Grows both
|
||||
-- horizontally and vertically.
|
||||
fill :: Char -> Widget
|
||||
fill :: Char -> Widget n
|
||||
fill ch =
|
||||
Widget Greedy Greedy $ do
|
||||
c <- getContext
|
||||
@ -238,7 +238,7 @@ fill ch =
|
||||
-- in the specified order (uppermost first). Defers growth policies to
|
||||
-- the growth policies of the contained widgets (if any are greedy, so
|
||||
-- is the box).
|
||||
vBox :: [Widget] -> Widget
|
||||
vBox :: [Widget n] -> Widget n
|
||||
vBox [] = emptyWidget
|
||||
vBox pairs = renderBox vBoxRenderer pairs
|
||||
|
||||
@ -246,7 +246,7 @@ vBox pairs = renderBox vBoxRenderer pairs
|
||||
-- in the specified order (leftmost first). Defers growth policies to
|
||||
-- the growth policies of the contained widgets (if any are greedy, so
|
||||
-- is the box).
|
||||
hBox :: [Widget] -> Widget
|
||||
hBox :: [Widget n] -> Widget n
|
||||
hBox [] = emptyWidget
|
||||
hBox pairs = renderBox hBoxRenderer pairs
|
||||
|
||||
@ -260,20 +260,20 @@ hBox pairs = renderBox hBoxRenderer pairs
|
||||
-- horizontal if the box layout is vertical). Doing this permits us to
|
||||
-- have one implementation for box layout and parameterizing on the
|
||||
-- orientation of all of the operations.
|
||||
data BoxRenderer =
|
||||
data BoxRenderer n =
|
||||
BoxRenderer { contextPrimary :: Lens' Context Int
|
||||
, contextSecondary :: Lens' Context Int
|
||||
, imagePrimary :: V.Image -> Int
|
||||
, imageSecondary :: V.Image -> Int
|
||||
, limitPrimary :: Int -> Widget -> Widget
|
||||
, limitSecondary :: Int -> Widget -> Widget
|
||||
, primaryWidgetSize :: Widget -> Size
|
||||
, limitPrimary :: Int -> Widget n -> Widget n
|
||||
, limitSecondary :: Int -> Widget n -> Widget n
|
||||
, primaryWidgetSize :: Widget n -> Size
|
||||
, concatenatePrimary :: [V.Image] -> V.Image
|
||||
, locationFromOffset :: Int -> Location
|
||||
, padImageSecondary :: Int -> V.Image -> V.Attr -> V.Image
|
||||
}
|
||||
|
||||
vBoxRenderer :: BoxRenderer
|
||||
vBoxRenderer :: BoxRenderer n
|
||||
vBoxRenderer =
|
||||
BoxRenderer { contextPrimary = availHeightL
|
||||
, contextSecondary = availWidthL
|
||||
@ -289,7 +289,7 @@ vBoxRenderer =
|
||||
in V.horizCat [img, p]
|
||||
}
|
||||
|
||||
hBoxRenderer :: BoxRenderer
|
||||
hBoxRenderer :: BoxRenderer n
|
||||
hBoxRenderer =
|
||||
BoxRenderer { contextPrimary = availWidthL
|
||||
, contextSecondary = availHeightL
|
||||
@ -352,7 +352,7 @@ hBoxRenderer =
|
||||
-- Finally, the padded images are concatenated together vertically and
|
||||
-- returned along with the translated cursor positions and visibility
|
||||
-- requests.
|
||||
renderBox :: BoxRenderer -> [Widget] -> Widget
|
||||
renderBox :: BoxRenderer n -> [Widget n] -> Widget n
|
||||
renderBox br ws =
|
||||
Widget (maximum $ hSize <$> ws) (maximum $ vSize <$> ws) $ do
|
||||
c <- getContext
|
||||
@ -413,7 +413,7 @@ renderBox br ws =
|
||||
-- number of columns. This is important for constraining the horizontal
|
||||
-- growth of otherwise-greedy widgets. This is non-greedy horizontally
|
||||
-- and defers to the limited widget vertically.
|
||||
hLimit :: Int -> Widget -> Widget
|
||||
hLimit :: Int -> Widget n -> Widget n
|
||||
hLimit w p =
|
||||
Widget Fixed (vSize p) $
|
||||
withReaderT (& availWidthL .~ w) $ render $ cropToContext p
|
||||
@ -422,7 +422,7 @@ hLimit w p =
|
||||
-- number of rows. This is important for constraining the vertical
|
||||
-- growth of otherwise-greedy widgets. This is non-greedy vertically and
|
||||
-- defers to the limited widget horizontally.
|
||||
vLimit :: Int -> Widget -> Widget
|
||||
vLimit :: Int -> Widget n -> Widget n
|
||||
vLimit h p =
|
||||
Widget (hSize p) Fixed $
|
||||
withReaderT (& availHeightL .~ h) $ render $ cropToContext p
|
||||
@ -434,7 +434,7 @@ vLimit h p =
|
||||
-- get merged hierarchically and still fall back to the attribute map's
|
||||
-- default attribute. If you want to change the default attribute, use
|
||||
-- 'withDefAttr'.
|
||||
withAttr :: AttrName -> Widget -> Widget
|
||||
withAttr :: AttrName -> Widget n -> Widget n
|
||||
withAttr an p =
|
||||
Widget (hSize p) (vSize p) $
|
||||
withReaderT (& ctxAttrNameL .~ an) (render p)
|
||||
@ -442,7 +442,7 @@ withAttr an p =
|
||||
-- | Update the attribute map while rendering the specified widget: set
|
||||
-- its new default attribute to the one that we get by looking up the
|
||||
-- specified attribute name in the map.
|
||||
withDefAttr :: AttrName -> Widget -> Widget
|
||||
withDefAttr :: AttrName -> Widget n -> Widget n
|
||||
withDefAttr an p =
|
||||
Widget (hSize p) (vSize p) $ do
|
||||
c <- getContext
|
||||
@ -450,7 +450,7 @@ withDefAttr an p =
|
||||
|
||||
-- | When rendering the specified widget, update the attribute map with
|
||||
-- the specified transformation.
|
||||
updateAttrMap :: (AttrMap -> AttrMap) -> Widget -> Widget
|
||||
updateAttrMap :: (AttrMap -> AttrMap) -> Widget n -> Widget n
|
||||
updateAttrMap f p =
|
||||
Widget (hSize p) (vSize p) $
|
||||
withReaderT (& ctxAttrMapL %~ f) (render p)
|
||||
@ -458,19 +458,19 @@ updateAttrMap f p =
|
||||
-- | When rendering the specified widget, force all attribute lookups
|
||||
-- in the attribute map to use the value currently assigned to the
|
||||
-- specified attribute name.
|
||||
forceAttr :: AttrName -> Widget -> Widget
|
||||
forceAttr :: AttrName -> Widget n -> Widget n
|
||||
forceAttr an p =
|
||||
Widget (hSize p) (vSize p) $ do
|
||||
c <- getContext
|
||||
withReaderT (& ctxAttrMapL .~ (forceAttrMap (attrMapLookup an (c^.ctxAttrMapL)))) (render p)
|
||||
|
||||
-- | Build a widget directly from a raw Vty image.
|
||||
raw :: V.Image -> Widget
|
||||
raw :: V.Image -> Widget n
|
||||
raw img = Widget Fixed Fixed $ return $ def & imageL .~ img
|
||||
|
||||
-- | Translate the specified widget by the specified offset amount.
|
||||
-- Defers to the translated width for growth policy.
|
||||
translateBy :: Location -> Widget -> Widget
|
||||
translateBy :: Location -> Widget n -> Widget n
|
||||
translateBy off p =
|
||||
Widget (hSize p) (vSize p) $ do
|
||||
result <- render p
|
||||
@ -479,7 +479,7 @@ translateBy off p =
|
||||
|
||||
-- | Crop the specified widget on the left by the specified number of
|
||||
-- columns. Defers to the translated width for growth policy.
|
||||
cropLeftBy :: Int -> Widget -> Widget
|
||||
cropLeftBy :: Int -> Widget n -> Widget n
|
||||
cropLeftBy cols p =
|
||||
Widget (hSize p) (vSize p) $ do
|
||||
result <- render p
|
||||
@ -490,7 +490,7 @@ cropLeftBy cols p =
|
||||
|
||||
-- | Crop the specified widget on the right by the specified number of
|
||||
-- columns. Defers to the translated width for growth policy.
|
||||
cropRightBy :: Int -> Widget -> Widget
|
||||
cropRightBy :: Int -> Widget n -> Widget n
|
||||
cropRightBy cols p =
|
||||
Widget (hSize p) (vSize p) $ do
|
||||
result <- render p
|
||||
@ -500,7 +500,7 @@ cropRightBy cols p =
|
||||
|
||||
-- | Crop the specified widget on the top by the specified number of
|
||||
-- rows. Defers to the translated width for growth policy.
|
||||
cropTopBy :: Int -> Widget -> Widget
|
||||
cropTopBy :: Int -> Widget n -> Widget n
|
||||
cropTopBy rows p =
|
||||
Widget (hSize p) (vSize p) $ do
|
||||
result <- render p
|
||||
@ -511,7 +511,7 @@ cropTopBy rows p =
|
||||
|
||||
-- | Crop the specified widget on the bottom by the specified number of
|
||||
-- rows. Defers to the translated width for growth policy.
|
||||
cropBottomBy :: Int -> Widget -> Widget
|
||||
cropBottomBy :: Int -> Widget n -> Widget n
|
||||
cropBottomBy rows p =
|
||||
Widget (hSize p) (vSize p) $ do
|
||||
result <- render p
|
||||
@ -521,19 +521,19 @@ cropBottomBy rows p =
|
||||
|
||||
-- | When rendering the specified widget, also register a cursor
|
||||
-- positioning request using the specified name and location.
|
||||
showCursor :: Name -> Location -> Widget -> Widget
|
||||
showCursor :: n -> Location -> Widget n -> Widget n
|
||||
showCursor n cloc p =
|
||||
Widget (hSize p) (vSize p) $ do
|
||||
result <- render p
|
||||
return $ result & cursorsL %~ (CursorLocation cloc (Just n):)
|
||||
|
||||
hRelease :: Widget -> Maybe Widget
|
||||
hRelease :: Widget n -> Maybe (Widget n)
|
||||
hRelease p =
|
||||
case hSize p of
|
||||
Fixed -> Just $ Widget Greedy (vSize p) $ withReaderT (& availWidthL .~ unrestricted) (render p)
|
||||
Greedy -> Nothing
|
||||
|
||||
vRelease :: Widget -> Maybe Widget
|
||||
vRelease :: Widget n -> Maybe (Widget n)
|
||||
vRelease p =
|
||||
case vSize p of
|
||||
Fixed -> Just $ Widget (hSize p) Greedy $ withReaderT (& availHeightL .~ unrestricted) (render p)
|
||||
@ -553,15 +553,16 @@ vRelease p =
|
||||
-- taking preference. If a viewport receives more than one scrolling
|
||||
-- request from 'Brick.Main.EventM', all are honored in the order in
|
||||
-- which they are received.
|
||||
viewport :: Name
|
||||
viewport :: (Ord n, Show n)
|
||||
=> n
|
||||
-- ^ The name of the viewport (must be unique and stable for
|
||||
-- reliable behavior)
|
||||
-> ViewportType
|
||||
-- ^ The type of viewport (indicates the permitted scrolling
|
||||
-- direction)
|
||||
-> Widget
|
||||
-> Widget n
|
||||
-- ^ The widget to be rendered in the scrollable viewport
|
||||
-> Widget
|
||||
-> Widget n
|
||||
viewport vpname typ p =
|
||||
Widget Greedy Greedy $ do
|
||||
-- First, update the viewport size.
|
||||
@ -577,17 +578,16 @@ viewport vpname typ p =
|
||||
-- constraint released (but raise an exception if we are asked to
|
||||
-- render an infinitely-sized widget in the viewport's scrolling
|
||||
-- dimension)
|
||||
let Name vpn = vpname
|
||||
release = case typ of
|
||||
let release = case typ of
|
||||
Vertical -> vRelease
|
||||
Horizontal -> hRelease
|
||||
Both ->vRelease >=> hRelease
|
||||
released = case release p of
|
||||
Just w -> w
|
||||
Nothing -> case typ of
|
||||
Vertical -> error $ "tried to embed an infinite-height widget in vertical viewport " <> (show vpn)
|
||||
Horizontal -> error $ "tried to embed an infinite-width widget in horizontal viewport " <> (show vpn)
|
||||
Both -> error $ "tried to embed an infinite-width or infinite-height widget in 'Both' type viewport " <> (show vpn)
|
||||
Vertical -> error $ "tried to embed an infinite-height widget in vertical viewport " <> (show vpname)
|
||||
Horizontal -> error $ "tried to embed an infinite-width widget in horizontal viewport " <> (show vpname)
|
||||
Both -> error $ "tried to embed an infinite-width or infinite-height widget in 'Both' type viewport " <> (show vpname)
|
||||
|
||||
initialResult <- render released
|
||||
|
||||
@ -666,7 +666,7 @@ viewport vpname typ p =
|
||||
-- is because viewports are updated during rendering and the one you are
|
||||
-- interested in may not have been rendered yet. So if you want to use
|
||||
-- this, be sure you know what you are doing.
|
||||
unsafeLookupViewport :: Name -> RenderM (Maybe Viewport)
|
||||
unsafeLookupViewport :: (Ord n) => n -> RenderM n (Maybe Viewport)
|
||||
unsafeLookupViewport name = lift $ gets (M.lookup name . (^.viewportMapL))
|
||||
|
||||
scrollTo :: ViewportType -> ScrollRequest -> V.Image -> Viewport -> Viewport
|
||||
@ -732,7 +732,7 @@ scrollToView Horizontal rq vp = vp & vpLeft .~ newHStart
|
||||
-- deal with the details of scrolling state management.
|
||||
--
|
||||
-- This does nothing if not rendered in a viewport.
|
||||
visible :: Widget -> Widget
|
||||
visible :: Widget n -> Widget n
|
||||
visible p =
|
||||
Widget (hSize p) (vSize p) $ do
|
||||
result <- render p
|
||||
@ -751,7 +751,7 @@ visible p =
|
||||
-- relative to the specified widget's upper-left corner of (0, 0).
|
||||
--
|
||||
-- This does nothing if not rendered in a viewport.
|
||||
visibleRegion :: Location -> V.DisplayRegion -> Widget -> Widget
|
||||
visibleRegion :: Location -> V.DisplayRegion -> Widget n -> Widget n
|
||||
visibleRegion vrloc sz p =
|
||||
Widget (hSize p) (vSize p) $ do
|
||||
result <- render p
|
||||
@ -764,19 +764,19 @@ visibleRegion vrloc sz p =
|
||||
-- | Horizontal box layout: put the specified widgets next to each other
|
||||
-- in the specified order. Defers growth policies to the growth policies
|
||||
-- of both widgets. This operator is a binary version of 'hBox'.
|
||||
(<+>) :: Widget
|
||||
(<+>) :: Widget n
|
||||
-- ^ Left
|
||||
-> Widget
|
||||
-> Widget n
|
||||
-- ^ Right
|
||||
-> Widget
|
||||
-> Widget n
|
||||
(<+>) a b = hBox [a, b]
|
||||
|
||||
-- | Vertical box layout: put the specified widgets one above the other
|
||||
-- in the specified order. Defers growth policies to the growth policies
|
||||
-- of both widgets. This operator is a binary version of 'vBox'.
|
||||
(<=>) :: Widget
|
||||
(<=>) :: Widget n
|
||||
-- ^ Top
|
||||
-> Widget
|
||||
-> Widget n
|
||||
-- ^ Bottom
|
||||
-> Widget
|
||||
-> Widget n
|
||||
(<=>) a b = vBox [a, b]
|
||||
|
||||
@ -12,6 +12,8 @@ module Brick.Widgets.Dialog
|
||||
-- * Construction and rendering
|
||||
, dialog
|
||||
, renderDialog
|
||||
-- * Handling events
|
||||
, handleDialogEvent
|
||||
-- * Getting a dialog's current value
|
||||
, dialogSelection
|
||||
-- * Attributes
|
||||
@ -50,8 +52,8 @@ import Brick.AttrMap
|
||||
--
|
||||
-- * Tab: selecte the next button
|
||||
-- * Shift-tab: select the previous button
|
||||
data Dialog a =
|
||||
Dialog { dialogName :: Name
|
||||
data Dialog n a =
|
||||
Dialog { dialogName :: n
|
||||
-- ^ The dialog name
|
||||
, dialogTitle :: Maybe String
|
||||
-- ^ The dialog title
|
||||
@ -65,15 +67,15 @@ data Dialog a =
|
||||
|
||||
suffixLenses ''Dialog
|
||||
|
||||
instance HandleEvent (Dialog a) where
|
||||
handleEvent ev d =
|
||||
case ev of
|
||||
EvKey (KChar '\t') [] -> return $ nextButtonBy 1 d
|
||||
EvKey KBackTab [] -> return $ nextButtonBy (-1) d
|
||||
_ -> return d
|
||||
handleDialogEvent :: Event -> Dialog n a -> EventM n (Dialog n a)
|
||||
handleDialogEvent ev d =
|
||||
return $ case ev of
|
||||
EvKey (KChar '\t') [] -> nextButtonBy 1 d
|
||||
EvKey KBackTab [] -> nextButtonBy (-1) d
|
||||
_ -> d
|
||||
|
||||
-- | Create a dialog.
|
||||
dialog :: Name
|
||||
dialog :: n
|
||||
-- ^ The dialog name, provided so that you can use this as a
|
||||
-- basis for viewport names in the dialog if desired
|
||||
-> Maybe String
|
||||
@ -83,7 +85,7 @@ dialog :: Name
|
||||
-- the button labels and values to use
|
||||
-> Int
|
||||
-- ^ The maximum width of the dialog
|
||||
-> Dialog a
|
||||
-> Dialog n a
|
||||
dialog name title buttonData w =
|
||||
let (buttons, idx) = case buttonData of
|
||||
Nothing -> ([], Nothing)
|
||||
@ -104,7 +106,7 @@ buttonSelectedAttr :: AttrName
|
||||
buttonSelectedAttr = buttonAttr <> "selected"
|
||||
|
||||
-- | Render a dialog with the specified body widget.
|
||||
renderDialog :: Dialog a -> Widget -> Widget
|
||||
renderDialog :: Dialog n a -> Widget n -> Widget n
|
||||
renderDialog d body =
|
||||
let buttonPadding = str " "
|
||||
mkButton (i, (s, _)) = let att = if Just i == d^.dialogSelectedIndexL
|
||||
@ -123,7 +125,7 @@ renderDialog d body =
|
||||
, hCenter buttons
|
||||
]
|
||||
|
||||
nextButtonBy :: Int -> Dialog a -> Dialog a
|
||||
nextButtonBy :: Int -> Dialog n a -> Dialog n a
|
||||
nextButtonBy amt d =
|
||||
let numButtons = length $ d^.dialogButtonsL
|
||||
in if numButtons == 0 then d
|
||||
@ -134,7 +136,7 @@ nextButtonBy amt d =
|
||||
-- | Obtain the value associated with the dialog's currently-selected
|
||||
-- button, if any. This function is probably what you want when someone
|
||||
-- presses 'Enter' in a dialog.
|
||||
dialogSelection :: Dialog a -> Maybe a
|
||||
dialogSelection :: Dialog n a -> Maybe a
|
||||
dialogSelection d =
|
||||
case d^.dialogSelectedIndexL of
|
||||
Nothing -> Nothing
|
||||
|
||||
@ -15,6 +15,8 @@ module Brick.Widgets.Edit
|
||||
, editor
|
||||
-- * Reading editor contents
|
||||
, getEditContents
|
||||
-- * Handling events
|
||||
, handleEditorEvent
|
||||
-- * Editing text
|
||||
, applyEdit
|
||||
-- * Lenses for working with editors
|
||||
@ -45,19 +47,19 @@ import Brick.AttrMap
|
||||
-- * Ctrl-k: delete all from cursor to end of line
|
||||
-- * Arrow keys: move cursor
|
||||
-- * Enter: break the current line at the cursor position
|
||||
data Editor =
|
||||
data Editor n =
|
||||
Editor { editContents :: Z.TextZipper String
|
||||
-- ^ The contents of the editor
|
||||
, editDrawContents :: [String] -> Widget
|
||||
, editDrawContents :: [String] -> Widget n
|
||||
-- ^ The function the editor uses to draw its contents
|
||||
, editorName :: Name
|
||||
, editorName :: n
|
||||
-- ^ The name of the editor
|
||||
}
|
||||
|
||||
suffixLenses ''Editor
|
||||
|
||||
instance HandleEvent Editor where
|
||||
handleEvent e ed =
|
||||
handleEditorEvent :: Event -> Editor n -> EventM n (Editor n)
|
||||
handleEditorEvent e ed =
|
||||
let f = case e of
|
||||
EvKey (KChar 'a') [MCtrl] -> Z.gotoBOL
|
||||
EvKey (KChar 'e') [MCtrl] -> Z.gotoEOL
|
||||
@ -75,16 +77,16 @@ instance HandleEvent Editor where
|
||||
in return $ applyEdit f ed
|
||||
|
||||
-- | Construct an editor.
|
||||
editor :: Name
|
||||
editor :: n
|
||||
-- ^ The editor's name (must be unique)
|
||||
-> ([String] -> Widget)
|
||||
-> ([String] -> Widget n)
|
||||
-- ^ The content rendering function
|
||||
-> Maybe Int
|
||||
-- ^ The limit on the number of lines in the editor ('Nothing'
|
||||
-- means no limit)
|
||||
-> String
|
||||
-- ^ The initial content
|
||||
-> Editor
|
||||
-> Editor n
|
||||
editor name draw limit s = Editor (Z.stringZipper [s] limit) draw name
|
||||
|
||||
-- | Apply an editing operation to the editor's contents. Bear in mind
|
||||
@ -93,8 +95,8 @@ editor name draw limit s = Editor (Z.stringZipper [s] limit) draw name
|
||||
-- text.
|
||||
applyEdit :: (Z.TextZipper String -> Z.TextZipper String)
|
||||
-- ^ The 'Data.Text.Zipper' editing transformation to apply
|
||||
-> Editor
|
||||
-> Editor
|
||||
-> Editor n
|
||||
-> Editor n
|
||||
applyEdit f e = e & editContentsL %~ f
|
||||
|
||||
-- | The attribute assigned to the editor
|
||||
@ -102,11 +104,11 @@ editAttr :: AttrName
|
||||
editAttr = "edit"
|
||||
|
||||
-- | Get the contents of the editor.
|
||||
getEditContents :: Editor -> [String]
|
||||
getEditContents :: Editor n -> [String]
|
||||
getEditContents e = Z.getText $ e^.editContentsL
|
||||
|
||||
-- | Turn an editor state value into a widget
|
||||
renderEditor :: Editor -> Widget
|
||||
renderEditor :: (Ord n, Show n) => Editor n -> Widget n
|
||||
renderEditor e =
|
||||
let cp = Z.cursorPosition $ e^.editContentsL
|
||||
cursorLoc = Location (cp^._2, cp^._1)
|
||||
|
||||
@ -18,11 +18,11 @@ import Brick.Types.Internal
|
||||
import Brick.AttrMap
|
||||
|
||||
renderFinal :: AttrMap
|
||||
-> [Widget]
|
||||
-> [Widget n]
|
||||
-> V.DisplayRegion
|
||||
-> ([CursorLocation] -> Maybe CursorLocation)
|
||||
-> RenderState
|
||||
-> (RenderState, V.Picture, Maybe CursorLocation)
|
||||
-> ([CursorLocation n] -> Maybe (CursorLocation n))
|
||||
-> RenderState n
|
||||
-> (RenderState n, V.Picture, Maybe (CursorLocation n))
|
||||
renderFinal aMap layerRenders sz chooseCursor rs = (newRS, pic, theCursor)
|
||||
where
|
||||
(layerResults, !newRS) = flip runState rs $ sequence $
|
||||
@ -35,11 +35,11 @@ renderFinal aMap layerRenders sz chooseCursor rs = (newRS, pic, theCursor)
|
||||
|
||||
-- | After rendering the specified widget, crop its result image to the
|
||||
-- dimensions in the rendering context.
|
||||
cropToContext :: Widget -> Widget
|
||||
cropToContext :: Widget n -> Widget n
|
||||
cropToContext p =
|
||||
Widget (hSize p) (vSize p) (render p >>= cropResultToContext)
|
||||
|
||||
cropResultToContext :: Result -> RenderM Result
|
||||
cropResultToContext :: Result n -> RenderM n (Result n)
|
||||
cropResultToContext result = do
|
||||
c <- getContext
|
||||
return $ result & imageL %~ (V.crop (c^.availWidthL) (c^.availHeightL))
|
||||
|
||||
@ -15,6 +15,9 @@ module Brick.Widgets.List
|
||||
-- * Rendering a list
|
||||
, renderList
|
||||
|
||||
-- * Handling events
|
||||
, handleListEvent
|
||||
|
||||
-- * Lenses
|
||||
, listElementsL
|
||||
, listSelectedL
|
||||
@ -62,34 +65,33 @@ import Brick.AttrMap
|
||||
-- at a time (based on the number of items shown)
|
||||
-- * Home/end keys: move cursor of selected item to beginning or end of
|
||||
-- list
|
||||
data List e =
|
||||
data List n e =
|
||||
List { listElements :: !(V.Vector e)
|
||||
, listSelected :: !(Maybe Int)
|
||||
, listName :: Name
|
||||
, listName :: n
|
||||
, listItemHeight :: Int
|
||||
} deriving (Functor, Foldable, Traversable)
|
||||
|
||||
suffixLenses ''List
|
||||
|
||||
instance HandleEvent (List e) where
|
||||
handleEvent e theList = f
|
||||
where
|
||||
f = case e of
|
||||
EvKey KUp [] -> return $ listMoveUp theList
|
||||
EvKey KDown [] -> return $ listMoveDown theList
|
||||
EvKey KHome [] -> return $ listMoveTo 0 theList
|
||||
EvKey KEnd [] -> return $ listMoveTo (V.length $ listElements theList) theList
|
||||
EvKey KPageDown [] -> do
|
||||
v <- lookupViewport (theList^.listNameL)
|
||||
case v of
|
||||
Nothing -> return theList
|
||||
Just vp -> return $ listMoveBy (vp^.vpSize._2 `div` theList^.listItemHeightL) theList
|
||||
EvKey KPageUp [] -> do
|
||||
v <- lookupViewport (theList^.listNameL)
|
||||
case v of
|
||||
Nothing -> return theList
|
||||
Just vp -> return $ listMoveBy (negate $ vp^.vpSize._2 `div` theList^.listItemHeightL) theList
|
||||
_ -> return theList
|
||||
handleListEvent :: (Show n, Ord n) => Event -> List n e -> EventM n (List n e)
|
||||
handleListEvent e theList =
|
||||
case e of
|
||||
EvKey KUp [] -> return $ listMoveUp theList
|
||||
EvKey KDown [] -> return $ listMoveDown theList
|
||||
EvKey KHome [] -> return $ listMoveTo 0 theList
|
||||
EvKey KEnd [] -> return $ listMoveTo (V.length $ listElements theList) theList
|
||||
EvKey KPageDown [] -> do
|
||||
v <- lookupViewport (theList^.listNameL)
|
||||
case v of
|
||||
Nothing -> return theList
|
||||
Just vp -> return $ listMoveBy (vp^.vpSize._2 `div` theList^.listItemHeightL) theList
|
||||
EvKey KPageUp [] -> do
|
||||
v <- lookupViewport (theList^.listNameL)
|
||||
case v of
|
||||
Nothing -> return theList
|
||||
Just vp -> return $ listMoveBy (negate $ vp^.vpSize._2 `div` theList^.listItemHeightL) theList
|
||||
_ -> return theList
|
||||
|
||||
-- | The top-level attribute used for the entire list.
|
||||
listAttr :: AttrName
|
||||
@ -101,31 +103,32 @@ listSelectedAttr :: AttrName
|
||||
listSelectedAttr = listAttr <> "selected"
|
||||
|
||||
-- | Construct a list in terms of an element type 'e'.
|
||||
list :: Name
|
||||
list :: n
|
||||
-- ^ The list name (must be unique)
|
||||
-> V.Vector e
|
||||
-- ^ The initial list contents
|
||||
-> Int
|
||||
-- ^ The list item height in rows (all list item widgets must be
|
||||
-- this high)
|
||||
-> List e
|
||||
-> List n e
|
||||
list name es h =
|
||||
let selIndex = if V.null es then Nothing else Just 0
|
||||
in List es selIndex name h
|
||||
|
||||
-- | Turn a list state value into a widget given an item drawing
|
||||
-- function.
|
||||
renderList :: List e
|
||||
renderList :: (Ord n, Show n)
|
||||
=> List n e
|
||||
-- ^ The List to be rendered
|
||||
-> (Bool -> e -> Widget)
|
||||
-> (Bool -> e -> Widget n)
|
||||
-- ^ Rendering function, True for the selected element
|
||||
-> Widget
|
||||
-> Widget n
|
||||
-- ^ rendered widget
|
||||
renderList l drawElem =
|
||||
withDefAttr listAttr $
|
||||
drawListElements l drawElem
|
||||
|
||||
drawListElements :: List e -> (Bool -> e -> Widget) -> Widget
|
||||
drawListElements :: (Ord n, Show n) => List n e -> (Bool -> e -> Widget n) -> Widget n
|
||||
drawListElements l drawElem =
|
||||
Widget Greedy Greedy $ do
|
||||
c <- getContext
|
||||
@ -156,8 +159,8 @@ listInsert :: Int
|
||||
-- ^ The position at which to insert (0 <= i <= size)
|
||||
-> e
|
||||
-- ^ The element to insert
|
||||
-> List e
|
||||
-> List e
|
||||
-> List n e
|
||||
-> List n e
|
||||
listInsert pos e l =
|
||||
let safePos = clamp 0 (V.length es) pos
|
||||
es = l^.listElementsL
|
||||
@ -173,8 +176,8 @@ listInsert pos e l =
|
||||
-- | Remove an element from a list at the specified position.
|
||||
listRemove :: Int
|
||||
-- ^ The position at which to remove an element (0 <= i < size)
|
||||
-> List e
|
||||
-> List e
|
||||
-> List n e
|
||||
-> List n e
|
||||
listRemove pos l | V.null (l^.listElementsL) = l
|
||||
| pos /= clamp 0 (V.length (l^.listElementsL) - 1) pos = l
|
||||
| otherwise =
|
||||
@ -193,7 +196,7 @@ listRemove pos l | V.null (l^.listElementsL) = l
|
||||
-- | Replace the contents of a list with a new set of elements and
|
||||
-- update the new selected index. If the specified selected index (via
|
||||
-- 'Just') is not in the list bounds, zero is used instead.
|
||||
listReplace :: Eq e => V.Vector e -> Maybe Int -> List e -> List e
|
||||
listReplace :: Eq e => V.Vector e -> Maybe Int -> List n e -> List n e
|
||||
listReplace es idx l =
|
||||
let newSel = clamp 0 (V.length es - 1) <$> idx
|
||||
in l & listSelectedL .~ newSel
|
||||
@ -201,24 +204,24 @@ listReplace es idx l =
|
||||
|
||||
-- | Move the list selected index up by one. (Moves the cursor up,
|
||||
-- subtracts one from the index.)
|
||||
listMoveUp :: List e -> List e
|
||||
listMoveUp :: List n e -> List n e
|
||||
listMoveUp = listMoveBy (-1)
|
||||
|
||||
-- | Move the list selected index down by one. (Moves the cursor down,
|
||||
-- adds one to the index.)
|
||||
listMoveDown :: List e -> List e
|
||||
listMoveDown :: List n e -> List n e
|
||||
listMoveDown = listMoveBy 1
|
||||
|
||||
-- | Move the list selected index by the specified amount, subject to
|
||||
-- validation.
|
||||
listMoveBy :: Int -> List e -> List e
|
||||
listMoveBy :: Int -> List n e -> List n e
|
||||
listMoveBy amt l =
|
||||
let newSel = clamp 0 (V.length (l^.listElementsL) - 1) <$> (amt +) <$> (l^.listSelectedL)
|
||||
in l & listSelectedL .~ newSel
|
||||
|
||||
-- | Set the selected index for a list to the specified index, subject
|
||||
-- to validation.
|
||||
listMoveTo :: Int -> List e -> List e
|
||||
listMoveTo :: Int -> List n e -> List n e
|
||||
listMoveTo pos l =
|
||||
let len = V.length (l^.listElementsL)
|
||||
newSel = clamp 0 (len - 1) $ if pos < 0 then len - pos else pos
|
||||
@ -227,18 +230,18 @@ listMoveTo pos l =
|
||||
else Nothing
|
||||
|
||||
-- | Return a list's selected element, if any.
|
||||
listSelectedElement :: List e -> Maybe (Int, e)
|
||||
listSelectedElement :: List n e -> Maybe (Int, e)
|
||||
listSelectedElement l = do
|
||||
sel <- l^.listSelectedL
|
||||
return (sel, (l^.listElementsL) V.! sel)
|
||||
|
||||
-- | Remove all elements from the list and clear the selection.
|
||||
listClear :: List e -> List e
|
||||
listClear :: List n e -> List n e
|
||||
listClear l = l & listElementsL .~ V.empty & listSelectedL .~ Nothing
|
||||
|
||||
-- | Reverse the list. The element selected before the reversal will
|
||||
-- again be the selected one.
|
||||
listReverse :: List e -> List e
|
||||
listReverse :: List n e -> List n e
|
||||
listReverse theList = theList & listElementsL %~ V.reverse & listSelectedL .~ newSel
|
||||
where n = V.length (listElements theList)
|
||||
newSel = (-) <$> pure (n-1) <*> listSelected theList
|
||||
|
||||
@ -32,7 +32,7 @@ progressBar :: Maybe String
|
||||
-- the progress bar.
|
||||
-> Float
|
||||
-- ^ The progress value. Should be between 0 and 1 inclusive.
|
||||
-> Widget
|
||||
-> Widget n
|
||||
progressBar mLabel progress =
|
||||
Widget Greedy Fixed $ do
|
||||
c <- getContext
|
||||
|
||||
Loading…
Reference in New Issue
Block a user