{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
module Brick.Widgets.Dialog
( Dialog
, dialogTitle
, dialogButtons
, dialogSelectedIndex
, dialogWidth
, dialog
, renderDialog
, handleDialogEvent
, dialogSelection
, dialogAttr
, buttonAttr
, buttonSelectedAttr
, dialogButtonsL
, dialogSelectedIndexL
, dialogWidthL
, dialogTitleL
)
where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
import Lens.Micro
#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid
#endif
import Data.List (intersperse)
import Graphics.Vty.Input (Event(..), Key(..))
import Brick.Util (clamp)
import Brick.Types
import Brick.Widgets.Core
import Brick.Widgets.Center
import Brick.Widgets.Border
import Brick.AttrMap
data Dialog a =
Dialog { dialogTitle :: Maybe String
, dialogButtons :: [(String, a)]
, dialogSelectedIndex :: Maybe Int
, dialogWidth :: Int
}
suffixLenses ''Dialog
handleDialogEvent :: Event -> Dialog a -> EventM n (Dialog a)
handleDialogEvent ev d =
return $ 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
dialog :: Maybe String
-> Maybe (Int, [(String, a)])
-> Int
-> Dialog a
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
dialogAttr :: AttrName
dialogAttr = "dialog"
buttonAttr :: AttrName
buttonAttr = "button"
buttonSelectedAttr :: AttrName
buttonSelectedAttr = buttonAttr <> "selected"
renderDialog :: Dialog a -> 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 <> " "
buttons = hBox $ intersperse buttonPadding $
mkButton <$> (zip [0..] (d^.dialogButtonsL))
doBorder = maybe border borderWithLabel (str <$> d^.dialogTitleL)
in centerLayer $
withDefAttr dialogAttr $
hLimit (d^.dialogWidthL) $
doBorder $
vBox [ body
, 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
dialogSelection :: Dialog a -> Maybe a
dialogSelection d =
case d^.dialogSelectedIndexL of
Nothing -> Nothing
Just i -> Just $ ((d^.dialogButtonsL) !! i)^._2