module Matterhorn.Draw.Buttons
  ( drawButton
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick
import           Brick.Focus
import           Brick.Widgets.Center

import qualified Data.Text as T

import           Matterhorn.Themes


buttonWidth :: Int
buttonWidth :: Int
buttonWidth = Int
10

drawButton :: (Eq n, Ord n) => FocusRing n -> n -> T.Text -> Widget n
drawButton :: forall n. (Eq n, Ord n) => FocusRing n -> n -> Text -> Widget n
drawButton FocusRing n
f n
n Text
label =
    let attr :: AttrName
attr = if forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing n
f forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just n
n
               then AttrName
buttonFocusedAttr
               else AttrName
buttonAttr
    in forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
attr forall a b. (a -> b) -> a -> b
$
       forall n. Ord n => n -> Widget n -> Widget n
clickable n
n forall a b. (a -> b) -> a -> b
$
       forall n. Int -> Widget n -> Widget n
hLimit Int
buttonWidth forall a b. (a -> b) -> a -> b
$
       forall n. Widget n -> Widget n
hCenter forall a b. (a -> b) -> a -> b
$
       forall n. Text -> Widget n
txt Text
label