diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,24 @@ Brick changelog --------------- +1.5 +--- + +This release focuses on API improvements in `Brick.Widgets.Dialog`: + +* `Dialog` got an additional type argument, `n`, for resource names. +* The `dialog` constructor now takes `[(String, n, a)]` rather than + `[(String, a)]`; this allows the caller to associate a resource name + with each dialog button. +* Dialog buttons now report click events under their associated resource + names. +* Dialog buttons now `putCursor` when they are focused in order to work + better with screen readers. +* The `Dialog` module got `getDialogFocus` and `setDialogFocus` + functions to help with focus management, and as part of this change, + the `dialogSelectedIndex` function and its lens `dialogSelectedIndexL` + were removed. + 1.4 --- diff --git a/brick.cabal b/brick.cabal --- a/brick.cabal +++ b/brick.cabal @@ -1,5 +1,5 @@ name: brick -version: 1.4 +version: 1.5 synopsis: A declarative terminal user interface library description: Write terminal user interfaces (TUIs) painlessly with 'brick'! You diff --git a/programs/DialogDemo.hs b/programs/DialogDemo.hs --- a/programs/DialogDemo.hs +++ b/programs/DialogDemo.hs @@ -25,12 +25,18 @@ data Choice = Red | Blue | Green deriving Show -drawUI :: D.Dialog Choice -> [Widget ()] +data Name = + RedButton + | BlueButton + | GreenButton + deriving (Show, Eq, Ord) + +drawUI :: D.Dialog Choice Name -> [Widget Name] drawUI d = [ui] where ui = D.renderDialog d $ C.hCenter $ padAll 1 $ str "This is the dialog body." -appEvent :: BrickEvent () e -> T.EventM () (D.Dialog Choice) () +appEvent :: BrickEvent Name e -> T.EventM Name (D.Dialog Choice Name) () appEvent (VtyEvent ev) = case ev of V.EvKey V.KEsc [] -> M.halt @@ -38,12 +44,12 @@ _ -> D.handleDialogEvent ev appEvent _ = return () -initialState :: D.Dialog Choice -initialState = D.dialog (Just "Title") (Just (0, choices)) 50 +initialState :: D.Dialog Choice Name +initialState = D.dialog (Just $ str "Title") (Just (RedButton, choices)) 50 where - choices = [ ("Red", Red) - , ("Blue", Blue) - , ("Green", Green) + choices = [ ("Red", RedButton, Red) + , ("Blue", BlueButton, Blue) + , ("Green", GreenButton, Green) ] theMap :: A.AttrMap @@ -53,7 +59,7 @@ , (D.buttonSelectedAttr, bg V.yellow) ] -theApp :: M.App (D.Dialog Choice) e () +theApp :: M.App (D.Dialog Choice Name) e Name theApp = M.App { M.appDraw = drawUI , M.appChooseCursor = M.showFirstCursor diff --git a/src/Brick/Widgets/Dialog.hs b/src/Brick/Widgets/Dialog.hs --- a/src/Brick/Widgets/Dialog.hs +++ b/src/Brick/Widgets/Dialog.hs @@ -5,21 +5,25 @@ -- dialog title, if any, as well as its body and buttons. -- -- Note that this dialog is really for simple use cases where you want --- to get the user's answer to a question, such as "Would you like --- to save changes before quitting?" If you require something more --- sophisticated, you'll need to build it yourself. You might also --- consider seeing the 'Brick.Forms' module for help with input --- management, and see the implementation of this module to see how to --- reproduce a dialog-style UI. +-- to get the user's answer to a question, such as "Would you like to +-- save changes before quitting?" As is typical in such cases, we assume +-- that this dialog box is used modally, meaning that while it is open +-- it is has exclusive input focus until it is closed. +-- +-- If you require something more sophisticated, you'll need to build it +-- yourself. You might also consider seeing the 'Brick.Forms' module for +-- help with input management and see the implementation of this module +-- to see how to reproduce a dialog-style UI. module Brick.Widgets.Dialog ( Dialog , dialogTitle , dialogButtons - , dialogSelectedIndex , dialogWidth -- * Construction and rendering , dialog , renderDialog + , getDialogFocus + , setDialogFocus -- * Handling events , handleDialogEvent -- * Getting a dialog's current value @@ -30,20 +34,20 @@ , buttonSelectedAttr -- * Lenses , dialogButtonsL - , dialogSelectedIndexL , dialogWidthL , dialogTitleL ) where import Lens.Micro +import Lens.Micro.Mtl ((%=)) #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid #endif -import Data.List (intersperse) +import Data.List (intersperse, find) import Graphics.Vty.Input (Event(..), Key(..)) -import Brick.Util (clamp) +import Brick.Focus import Brick.Types import Brick.Widgets.Core import Brick.Widgets.Center @@ -59,43 +63,55 @@ -- -- * Tab or Right Arrow: select the next button -- * Shift-tab or Left Arrow: select the previous button -data Dialog a = - Dialog { dialogTitle :: Maybe String +data Dialog a n = + Dialog { dialogTitle :: Maybe (Widget n) -- ^ The dialog title - , dialogButtons :: [(String, a)] - -- ^ The dialog button labels and values - , dialogSelectedIndex :: Maybe Int - -- ^ The currently selected dialog button index (if any) + , dialogButtons :: [(String, n, a)] + -- ^ The dialog buttons' labels, resource names, and values , dialogWidth :: Int -- ^ The maximum width of the dialog + , dialogFocus :: FocusRing n + -- ^ The focus ring for the dialog's buttons } suffixLenses ''Dialog -handleDialogEvent :: Event -> EventM n (Dialog a) () +handleDialogEvent :: Event -> EventM n (Dialog a n) () handleDialogEvent ev = do - modify $ \d -> case ev of - EvKey (KChar '\t') [] -> nextButtonBy 1 True d - EvKey KBackTab [] -> nextButtonBy (-1) True d - EvKey KRight [] -> nextButtonBy 1 False d - EvKey KLeft [] -> nextButtonBy (-1) False d - _ -> d + case ev of + EvKey (KChar '\t') [] -> dialogFocusL %= focusNext + EvKey KRight [] -> dialogFocusL %= focusNext + EvKey KBackTab [] -> dialogFocusL %= focusPrev + EvKey KLeft [] -> dialogFocusL %= focusPrev + _ -> return () +-- | Set the focused button of a dialog. +setDialogFocus :: (Eq n) => n -> Dialog a n -> Dialog a n +setDialogFocus n d = d { dialogFocus = focusSetCurrent n $ dialogFocus d } + +-- | Get the focused button of a dialog. +getDialogFocus :: Dialog a n -> Maybe n +getDialogFocus = focusGetCurrent . dialogFocus + -- | Create a dialog. -dialog :: Maybe String +dialog :: (Eq n) + => Maybe (Widget n) -- ^ The dialog title - -> Maybe (Int, [(String, a)]) - -- ^ The currently-selected button index (starting at zero) and - -- the button labels and values to use + -> Maybe (n, [(String, n, a)]) + -- ^ The currently-selected button resource name and the button + -- labels, resource names, and values to use for each button, + -- respectively -> Int -- ^ The maximum width of the dialog - -> Dialog a + -> Dialog a n dialog title buttonData w = - let (buttons, idx) = case buttonData of - Nothing -> ([], Nothing) - Just (_, []) -> ([], Nothing) - Just (i, bs) -> (bs, Just $ clamp 0 (length bs - 1) i) - in Dialog title buttons idx w + let (r, buttons) = case buttonData of + Nothing -> + (focusRing [], []) + Just (focName, entries) -> + let ns = (\(_, n, _) -> n) <$> entries + in (focusSetCurrent focName $ focusRing ns, entries) + in Dialog title buttons w r -- | The default attribute of the dialog dialogAttr :: AttrName @@ -113,17 +129,25 @@ -- dialog as a layer, which makes this suitable as a top-level layer in -- your rendering function to be rendered on top of the rest of your -- interface. -renderDialog :: Dialog a -> Widget n -> Widget n +renderDialog :: (Ord n) => Dialog a n -> Widget n -> Widget n renderDialog d body = let buttonPadding = str " " - mkButton (i, (s, _)) = let att = if Just i == d^.dialogSelectedIndexL - then buttonSelectedAttr - else buttonAttr - in withAttr att $ str $ " " <> s <> " " + foc = focusGetCurrent $ dialogFocus d + mkButton (s, n, _) = + let att = if Just n == foc + then buttonSelectedAttr + else buttonAttr + csr = if Just n == foc + then putCursor n (Location (1,0)) + else id + in csr $ + clickable n $ + withAttr att $ + str $ " " <> s <> " " buttons = hBox $ intersperse buttonPadding $ - mkButton <$> (zip [0..] (d^.dialogButtonsL)) + mkButton <$> (d^.dialogButtonsL) - doBorder = maybe border borderWithLabel (str <$> d^.dialogTitleL) + doBorder = maybe border borderWithLabel (d^.dialogTitleL) in centerLayer $ withDefAttr dialogAttr $ hLimit (d^.dialogWidthL) $ @@ -132,24 +156,12 @@ , hCenter buttons ] -nextButtonBy :: Int -> Bool -> Dialog a -> Dialog a -nextButtonBy amt wrapCycle d = - let numButtons = length $ d^.dialogButtonsL - in if numButtons == 0 then d - else case d^.dialogSelectedIndexL of - Nothing -> d & dialogSelectedIndexL .~ (Just 0) - Just i -> d & dialogSelectedIndexL .~ (Just newIndex) - where - addedIndex = i + amt - newIndex = if wrapCycle - then addedIndex `mod` numButtons - else max 0 $ min addedIndex $ numButtons - 1 - --- | 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 d = - case d^.dialogSelectedIndexL of - Nothing -> Nothing - Just i -> Just $ ((d^.dialogButtonsL) !! i)^._2 +-- | Obtain the resource name and value associated with the dialog's +-- currently-selected button, if any. The result of this function is +-- probably what you want when someone presses 'Enter' in a dialog. +dialogSelection :: (Eq n) => Dialog a n -> Maybe (n, a) +dialogSelection d = do + n' <- focusGetCurrent $ dialogFocus d + let matches (_, n, _) = n == n' + (_, n, a) <- find matches (d^.dialogButtonsL) + return (n, a)