mirror of
https://github.com/jtdaugherty/brick.git
synced 2024-09-11 23:57:22 +03:00
Add a dialog type and demo
This commit is contained in:
parent
91c4504ce4
commit
dfb999132b
1
TODO.txt
1
TODO.txt
@ -8,7 +8,6 @@ Features:
|
||||
- Port widgets from vty-ui:
|
||||
- Progress bar?
|
||||
- Dir browser?
|
||||
- Dialog?
|
||||
- Checkbox?
|
||||
- Button?
|
||||
- Overlays relative to a specific widget (e.g. drop-downs) using layers
|
||||
|
13
brick.cabal
13
brick.cabal
@ -42,6 +42,7 @@ library
|
||||
Brick.Widgets.Border.Style
|
||||
Brick.Widgets.Center
|
||||
Brick.Widgets.Core
|
||||
Brick.Widgets.Dialog
|
||||
Brick.Widgets.Edit
|
||||
Brick.Widgets.List
|
||||
Data.Text.Markup
|
||||
@ -100,6 +101,18 @@ executable brick-bench
|
||||
containers,
|
||||
vector
|
||||
|
||||
executable brick-dialog-demo
|
||||
hs-source-dirs: programs
|
||||
ghc-options: -threaded -Wall -fno-warn-unused-do-bind -O3
|
||||
default-language: Haskell2010
|
||||
main-is: DialogDemo.hs
|
||||
build-depends: base,
|
||||
brick,
|
||||
vty >= 5.2.9,
|
||||
data-default,
|
||||
text,
|
||||
lens
|
||||
|
||||
executable brick-layer-demo
|
||||
hs-source-dirs: programs
|
||||
ghc-options: -threaded -Wall -fno-warn-unused-do-bind -O3
|
||||
|
57
programs/DialogDemo.hs
Normal file
57
programs/DialogDemo.hs
Normal file
@ -0,0 +1,57 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Main where
|
||||
|
||||
import Data.Monoid
|
||||
import Graphics.Vty hiding (translate)
|
||||
|
||||
import Brick.Main
|
||||
import Brick.Widgets.Core
|
||||
import Brick.Widgets.Dialog
|
||||
import Brick.AttrMap
|
||||
import Brick.Util
|
||||
import Brick.Types
|
||||
|
||||
data Choice = Red | Blue | Green
|
||||
deriving Show
|
||||
|
||||
drawUI :: Dialog Choice -> [Widget]
|
||||
drawUI d = [ui]
|
||||
where
|
||||
ui = renderDialog d $ str "This is the dialog body."
|
||||
|
||||
appEvent :: Dialog Choice -> Event -> EventM (Next (Dialog Choice))
|
||||
appEvent d ev =
|
||||
case ev of
|
||||
EvKey KEsc [] -> halt d
|
||||
EvKey KEnter [] -> halt d
|
||||
_ -> continue $ handleEvent ev d
|
||||
|
||||
initialState :: Dialog Choice
|
||||
initialState = dialog "dialog" (Just "Title") (Just (0, choices)) 50
|
||||
where
|
||||
choices = [ ("Red", Red)
|
||||
, ("Blue", Blue)
|
||||
, ("Green", Green)
|
||||
]
|
||||
|
||||
theMap :: AttrMap
|
||||
theMap = attrMap defAttr
|
||||
[ (dialogAttr, white `on` blue)
|
||||
, (buttonAttr, black `on` white)
|
||||
, (buttonSelectedAttr, bg yellow)
|
||||
]
|
||||
|
||||
theApp :: App (Dialog Choice) Event
|
||||
theApp =
|
||||
App { appDraw = drawUI
|
||||
, appChooseCursor = showFirstCursor
|
||||
, appHandleEvent = appEvent
|
||||
, appStartEvent = return
|
||||
, appAttrMap = const theMap
|
||||
, appMakeVtyEvent = id
|
||||
}
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
d <- defaultMain theApp initialState
|
||||
putStrLn $ "You chose: " <> show (dialogSelection d)
|
100
src/Brick/Widgets/Dialog.hs
Normal file
100
src/Brick/Widgets/Dialog.hs
Normal file
@ -0,0 +1,100 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Brick.Widgets.Dialog
|
||||
( Dialog
|
||||
, dialog
|
||||
, renderDialog
|
||||
, dialogSelection
|
||||
, dialogAttr
|
||||
, buttonAttr
|
||||
, buttonSelectedAttr
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Lens
|
||||
import Control.Applicative
|
||||
import Data.Monoid
|
||||
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 { dialogName :: Name
|
||||
, dialogTitle :: Maybe String
|
||||
, dialogButtons :: [(String, a)]
|
||||
, dialogSelectedIndex :: Maybe Int
|
||||
, dialogWidth :: Int
|
||||
}
|
||||
|
||||
suffixLenses ''Dialog
|
||||
|
||||
instance HandleEvent (Dialog a) where
|
||||
handleEvent ev d =
|
||||
case ev of
|
||||
EvKey (KChar '\t') [] -> nextButton d
|
||||
EvKey KBackTab [] -> prevButton d
|
||||
_ -> d
|
||||
|
||||
dialog :: Name -> Maybe String -> Maybe (Int, [(String, a)]) -> Int -> Dialog a
|
||||
dialog name 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 name title buttons idx w
|
||||
|
||||
dialogAttr :: AttrName
|
||||
dialogAttr = "dialog"
|
||||
|
||||
buttonAttr :: AttrName
|
||||
buttonAttr = "button"
|
||||
|
||||
buttonSelectedAttr :: AttrName
|
||||
buttonSelectedAttr = buttonAttr <> "selected"
|
||||
|
||||
renderDialog :: Dialog a -> Widget -> Widget
|
||||
renderDialog d body =
|
||||
let buttonPadding = " "
|
||||
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 center $
|
||||
withDefaultAttr dialogAttr $
|
||||
doBorder $
|
||||
hLimit (d^.dialogWidthL) $
|
||||
vBox [ body
|
||||
, hCenter buttons
|
||||
]
|
||||
|
||||
nextButton :: Dialog a -> Dialog a
|
||||
nextButton d =
|
||||
if null (d^.dialogButtonsL)
|
||||
then d
|
||||
else case d^.dialogSelectedIndexL of
|
||||
Nothing -> d & dialogSelectedIndexL .~ (Just 0)
|
||||
Just i -> d & dialogSelectedIndexL .~ (Just $ (i + 1) `mod` (length (d^.dialogButtonsL)))
|
||||
|
||||
prevButton :: Dialog a -> Dialog a
|
||||
prevButton d =
|
||||
if null (d^.dialogButtonsL)
|
||||
then d
|
||||
else case d^.dialogSelectedIndexL of
|
||||
Nothing -> d & dialogSelectedIndexL .~ (Just 0)
|
||||
Just i -> d & dialogSelectedIndexL .~ (Just $ (i - 1) `mod` (length (d^.dialogButtonsL)))
|
||||
|
||||
dialogSelection :: Dialog a -> Maybe a
|
||||
dialogSelection d =
|
||||
case d^.dialogSelectedIndexL of
|
||||
Nothing -> Nothing
|
||||
Just i -> Just $ ((d^.dialogButtonsL) !! i)^._2
|
Loading…
Reference in New Issue
Block a user