Better aesth for context menu

This commit is contained in:
Luis Morillo 2024-02-28 17:11:00 +01:00
parent 32c2cd2efa
commit 40f94fa016
2 changed files with 46 additions and 25 deletions

View File

@ -150,6 +150,14 @@ fieldHelpMsgL = lens g s
where g (MenuField {..})= fieldInput ^. inputHelpL where g (MenuField {..})= fieldInput ^. inputHelpL
s (MenuField{..}) msg = MenuField {fieldInput = fieldInput & inputHelpL .~ msg , ..} s (MenuField{..}) msg = MenuField {fieldInput = fieldInput & inputHelpL .~ msg , ..}
-- | How to draw a field given a formater
drawField :: Formatter n -> Bool -> MenuField s n -> Widget n
drawField amp focus (MenuField { fieldInput = FieldInput {..}, ..}) =
let input = inputRender focus fieldStatus inputHelp inputState (amp focus)
in if focus
then Brick.visible input
else input
instance Brick.Named (MenuField s n) n where instance Brick.Named (MenuField s n) n where
getName :: MenuField s n -> n getName :: MenuField s n -> n
getName entry = entry & fieldName getName entry = entry & fieldName
@ -330,12 +338,6 @@ drawMenu menu =
<+> Brick.txt " to go back" <+> Brick.txt " to go back"
] ]
where where
drawField amp focus (MenuField { fieldInput = FieldInput {..}, ..}) =
let input = inputRender focus fieldStatus inputHelp inputState (amp focus)
in if focus
then Brick.visible input
else input
fieldLabels = [field & fieldLabel | field <- menu ^. menuFieldsL] fieldLabels = [field & fieldLabel | field <- menu ^. menuFieldsL]
buttonLabels = [button & fieldLabel | button <- menu ^. menuButtonsL] buttonLabels = [button & fieldLabel | button <- menu ^. menuButtonsL]
allLabels = fieldLabels ++ buttonLabels allLabels = fieldLabels ++ buttonLabels

View File

@ -6,20 +6,25 @@ import Brick (
Widget (..), BrickEvent, EventM, Widget (..), BrickEvent, EventM,
) )
import Data.Function ((&)) import Data.Function ((&))
import qualified GHCup.Brick.Common as Common
import qualified GHCup.Brick.Widgets.Menu as Menu
import Prelude hiding (appendFile) import Prelude hiding (appendFile)
import qualified Data.Text as T
import Data.Versions (prettyVer) import Data.Versions (prettyVer)
import GHCup (ListResult (..)) import GHCup.List ( ListResult(..) )
import GHCup.Types (KeyCombination, Tool (..))
import qualified GHCup.Brick.Common as Common
import qualified GHCup.Brick.Widgets.Menu as Menu
import GHCup.Brick.Common (Name (..)) import GHCup.Brick.Common (Name (..))
import GHCup.Brick.Widgets.Menu (Menu) import GHCup.Brick.Widgets.Menu (Menu)
import GHCup.Types (KeyCombination, Tool (..)) import qualified Brick.Widgets.Core as Brick
import qualified Brick.Widgets.Border as Border
import qualified Brick.Focus as F
import Brick.Widgets.Core ((<+>))
import Optics (to) import Optics (to)
import Optics.Operators ((.~), (^.)) import Optics.Operators ((.~), (^.))
import Optics.Optic ((%)) import Optics.Optic ((%))
import Data.Foldable (foldl')
type ContextMenu = Menu ListResult Name type ContextMenu = Menu ListResult Name
@ -33,7 +38,7 @@ create lr exit_key = Menu.createMenu Common.ContextBox lr exit_key buttons []
compileButton = compileButton =
Menu.createButtonField (MenuElement Common.CompilieButton) Menu.createButtonField (MenuElement Common.CompilieButton)
& Menu.fieldLabelL .~ "Compile" & Menu.fieldLabelL .~ "Compile"
& Menu.fieldHelpMsgL .~ "Compile tool from source (to be implemented)" & Menu.fieldHelpMsgL .~ "Compile tool from source"
buttons = buttons =
case lTool lr of case lTool lr of
GHC -> [advInstallButton, compileButton] GHC -> [advInstallButton, compileButton]
@ -41,14 +46,28 @@ create lr exit_key = Menu.createMenu Common.ContextBox lr exit_key buttons []
_ -> [advInstallButton] _ -> [advInstallButton]
draw :: ContextMenu -> Widget Name draw :: ContextMenu -> Widget Name
draw ctx = draw menu =
Common.frontwardLayer Common.frontwardLayer
("Context Menu for " <> tool_str <> " " <> prettyVer (lVer $ ctx ^. Menu.menuStateL)) ("Context Menu for " <> tool_str <> " " <> prettyVer (lVer $ menu ^. Menu.menuStateL))
(Menu.drawMenu ctx) $ Brick.vBox
[ Brick.vBox buttonWidgets
, Brick.txt " "
, Brick.padRight Brick.Max $
Brick.txt "Press "
<+> Common.keyToWidget (menu ^. Menu.menuExitKeyL)
<+> Brick.txt " to go back"
]
where where
tool_str :: T.Text buttonLabels = [button & Menu.fieldLabel | button <- menu ^. Menu.menuButtonsL]
maxWidth = foldl' max 5 (fmap Brick.textWidth buttonLabels)
buttonAmplifiers =
let buttonAsWidgets = fmap Menu.renderAslabel buttonLabels
in fmap (\f b -> ((Menu.leftify (maxWidth + 10) . Border.border $ f b) <+>) ) buttonAsWidgets
drawButtons = fmap Menu.drawField buttonAmplifiers
buttonWidgets = zipWith (F.withFocusRing (menu ^. Menu.menuFocusRingL)) drawButtons (menu ^. Menu.menuButtonsL)
tool_str = tool_str =
case ctx ^. Menu.menuStateL % to lTool of case menu ^. Menu.menuStateL % to lTool of
GHC -> "GHC" GHC -> "GHC"
GHCup -> "GHCup" GHCup -> "GHCup"
Cabal -> "Cabal" Cabal -> "Cabal"