brick-dropdownmenu (empty) → 0.1.0
raw patch · 6 files changed
+474/−0 lines, 6 filesdep +basedep +brickdep +brick-dropdownmenusetup-changed
Dependencies added: base, brick, brick-dropdownmenu, containers, microlens, microlens-ghc, microlens-th, pointedlist, text, vector, vty
Files
- ChangeLog.md +5/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- app/Demo.hs +110/−0
- brick-dropdownmenu.cabal +76/−0
- src/Brick/Widgets/DropDownMenu.hs +251/−0
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Changelog for brick-dropdownmenu++## 0.1.0++Initial release.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Author name here (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Author name here nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Demo.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE TemplateHaskell #-}+module Main where++import Brick+import Brick.Focus+import Brick.Widgets.Border+import Brick.Widgets.Center+import Brick.Widgets.Edit+import Brick.Widgets.DropDownMenu+import Brick.Widgets.List (listAttr, listSelectedAttr)+import Control.Category ((>>>))+import Data.Maybe (fromMaybe, mapMaybe)+import Data.Text+import Graphics.Vty (defAttr, blue, white, Event(EvKey), Key(..), Modifier(..))+import Lens.Micro+import Lens.Micro.TH++data Name = MenuBar+ | FileMenu | FileOpen | FileQuit+ | EditMenu | EditCut+ | HelpMenu | HelpAbout+ | Editor+ | About+ deriving (Eq, Ord, Show)+data State = State {+ _menu :: DropDownMenu State Name+, _edit :: Editor Text Name+, _status :: String+, _focus :: FocusRing Name+}+makeLenses ''State++draw s = mconcat+ [ about $ focusGetCurrent (s^.focus) == Just About+ , [ withFocusRing (s^.focus) renderDropDownMenu (s^.menu)+ , translateBy (Location (0, 1)) $+ vBox [ withFocusRing (s^.focus) (renderEditor (txt . Data.Text.unlines)) (s^.edit)+ , str $ s^.status, str " "+ ]+ ]+ ]++about True = [centerLayer $ borderWithLabel (str "About this program") info]+ where+ info = padLeftRight 2 $ padTopBottom 1 $+ str "This is a demo of the dropdownmenu widget."+ <=> str " "+ <=> showCursor About (Location (0, 0)) (str "Press ESC to continue")+about _ = []+++handleEvent :: State -> BrickEvent Name e -> EventM Name (Next State)+handleEvent s (VtyEvent e) =+ fromMaybe accordingToFocus $+ handleGlobalDropDownMenuEvent s menu (setFocus MenuBar) e+ where+ accordingToFocus = case focusGetCurrent $ s^.focus of+ Just MenuBar -> if e == EvKey KEsc [] && not (isDropDownMenuOpen (s^.menu))+ then continue $ s & focus %~ focusSetCurrent Editor+ else handleDropDownMenuEvent s menu (setFocus MenuBar) e+ Just Editor -> case e of+ EvKey KEsc [] -> continue . setFocus MenuBar $ s+ _ -> continue =<< handleEventLensed s edit handleEditorEvent e+ Just About -> case e of+ EvKey KEsc [] -> continue . setFocus Editor $ s+ _ -> continue s+ Nothing -> continue s+handleEvent s _ = continue s++setFocus n = focus %~ focusSetCurrent n++exitMenu x = menu %~ closeDropDownMenu+ >>> focus %~ focusSetCurrent x++msg t = set status t >>> exitMenu Editor >>> continue++aboutDialog = exitMenu About >>> continue++menuD =+ [ ("File", FileMenu, Just (EvKey (KChar 'f') [MMeta]), + [ ("Open", FileOpen, Just (EvKey (KChar 'o') [MCtrl]), msg "Not implemented")+ , ("Quit", FileQuit, Just (EvKey (KChar 'q') [MCtrl]), halt)])+ , ("Edit", EditMenu, Just (EvKey (KChar 'e') [MMeta]),+ [("Cut", EditCut, Just (EvKey (KChar 'x') [MCtrl]), msg "This could cut something")])+ , ("Help", HelpMenu, Just (EvKey (KChar 'h') [MMeta]),+ [("About this program", HelpAbout, Nothing, aboutDialog)])+ ] ++demo = defaultMain+ App {+ appChooseCursor = showFirstCursor+, appDraw = draw+, appAttrMap = const attrs+, appStartEvent = pure+, appHandleEvent = handleEvent+}++main = demo State {+ _menu = dropDownMenu MenuBar menuD+, _edit = editor Editor Nothing (pack "You can change this text.\nPress ESC to go to the menu.")+, _status = "started."+, _focus = focusRing [Editor, About, MenuBar]+}++attrs = attrMap defAttr+ [ (menuAttr, white `on` blue)+ , (menuSelectedAttr, blue `on` white)+ , (listAttr, white `on` blue)+ , (listSelectedAttr, blue `on` white)+ ]
@@ -0,0 +1,76 @@+-- This file has been generated from package.yaml by hpack version 0.28.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: a585b898b2e28775a391fa1d72334d9dfcd5f96391fc26eb258a9a0fc13d9a3d++name: brick-dropdownmenu+version: 0.1.0+synopsis: A drop-down menu widget for brick.+description: A simple drop-down menu widget for the declarative text user interface library brick.+ Each submenu and menu item can have an associated global key binding.+category: Graphics+homepage: https://github.com/mlang/brick-dropdownmenu#readme+bug-reports: https://github.com/mlang/brick-dropdownmenu/issues+author: Mario Lang+maintainer: mlang@blind.guru+copyright: 2018 Mario Lang+license: BSD3+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10+extra-source-files:+ ChangeLog.md++source-repository head+ type: git+ location: https://github.com/mlang/brick-dropdownmenu++flag demo+ description: Build the demo program+ manual: True+ default: False++library+ exposed-modules:+ Brick.Widgets.DropDownMenu+ other-modules:+ Paths_brick_dropdownmenu+ hs-source-dirs:+ src+ build-depends:+ base >=4.7 && <5+ , brick >=0.35 && <0.42+ , containers+ , microlens+ , microlens-ghc+ , microlens-th+ , pointedlist+ , vector+ , vty+ default-language: Haskell2010++executable brick-dropdownmenu-demo+ main-is: Demo.hs+ other-modules:+ Paths_brick_dropdownmenu+ hs-source-dirs:+ app+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.7 && <5+ , brick >=0.35 && <0.42+ , brick-dropdownmenu+ , containers+ , microlens+ , microlens-ghc+ , microlens-th+ , pointedlist+ , text+ , vector+ , vty+ if flag(demo)+ buildable: True+ else+ buildable: False+ default-language: Haskell2010
+ src/Brick/Widgets/DropDownMenu.hs view
@@ -0,0 +1,251 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TemplateHaskell #-}+{-|+Module : Brick.Widgets.DropDownMenu+Description : A drop-down menu type and functions for manipulating and rendering it.+Copyright : (c) Mario Lang, 2018+License : BSD-style (see the file LICENSE)+Maintainer : mlang@blind.guru+Stability : experimental+Portability : POSIX++This module provides a simple drop-down menu widget with global key bindings.++A submenu consists of a title, a resource name, and an associated global event.+Each menu item consists of the items title, resource name, global event and+associated action.++An action is a function @s -> 'EventM' n ('Next' s)@.+-}+module Brick.Widgets.DropDownMenu (+ DropDownMenu+-- * Constructing a drop-down menu+, dropDownMenu+-- * Handling events+, handleDropDownMenuEvent, handleGlobalDropDownMenuEvent+-- * Rendering drop-down menus+, renderDropDownMenu+-- * Accessors+, isDropDownMenuOpen+-- * Manipulating a drop-down menu+, closeDropDownMenu+-- * Attributes+, menuAttr, menuSelectedAttr+) where++import Brick ( Named(..)+ , AttrName+ , EventM, Next+ , Location(..), Widget+ , continue, emptyWidget+ , handleEventLensed+ , hBox, hLimit+ , padLeftRight, padTopBottom+ , showCursor, str+ , textWidth, vLimit+ , withAttr+ )+import Brick.Widgets.Border ( borderWithLabel )+import Brick.Widgets.List ( List, list+ , handleListEvent+ , listElements, listMoveTo+ , listSelectedElement+ , renderList+ )+import Data.Foldable ( toList )+import Data.List ( find, findIndex+ , intersperse+ )+import Data.List.PointedList ( PointedList+ , focus, moveTo, withFocus+ )+import Data.List.PointedList.Circular ( next, previous )+import qualified Data.List.PointedList as PointedList ( fromList )+import Data.Map ( Map )+import qualified Data.Map as Map ( empty, fromList )+import Data.Maybe ( fromMaybe, mapMaybe )+import qualified Data.Vector as Vector ( fromList, length )+import Graphics.Vty ( Event(..)+ , Key(..), Modifier(..)+ )+import Lens.Micro.GHC ( Lens', LensLike'+ , _2, _Just+ , (&), (^.), (^?)+ , (.~), (%~), at, set+ )+import Lens.Micro.TH ( makeLenses )++type MenuItem s n = (String, n, Maybe Event, s -> EventM n (Next s))+type Menu s n = [(String, n, Maybe Event, [MenuItem s n])]+data Action s n = MoveTo !Int | Invoke (s -> EventM n (Next s))++-- | Drop-down menus present a menu bar with drop-down submenus.+--+-- Drop-down menus support the following events by default:+--+-- * Left/right arrow keys: Switch to previous/next submenu+-- * Up arrow key: Close submenu when already at top, otherwise move selection in submenu+-- * Down arrow key: Open submenu or move submenu selection downwards+-- * Escape: Close submenu+-- * Return: Open submenu or invoke selected submenu item+data DropDownMenu s n = DropDownMenu {+ _menuName :: n+, _menuOpen :: Bool+, _menuKeyMap :: Map Event (Action s n)+, _menuList :: Maybe (PointedList (String, List n (MenuItem s n)))+}++makeLenses ''DropDownMenu++submenuList+ :: Applicative f+ => LensLike' f (DropDownMenu s n) (List n (MenuItem s n))+submenuList = menuList . _Just . focus . _2++instance Named (DropDownMenu s n) n where getName = _menuName++dropDownMenu+ :: n+ -- ^ The resource name for this drop-down menu+ -> [(String, n, Maybe Event, [(String, n, Maybe Event, s -> EventM n (Next s))])]+ -- ^ Menu description+ -> DropDownMenu s n+dropDownMenu name desc =+ DropDownMenu name False keyMap $ PointedList.fromList $+ (\(t, n, _, c) -> (t, list n (Vector.fromList c) 1)) <$> desc+ where+ keyMap = Map.fromList . concat $ zipWith f [0..] desc where+ f i (_, _, Just e, xs) = (e, MoveTo i) : mapMaybe g xs+ f _ (_, _, Nothing, xs) = mapMaybe g xs+ g (_, _, Just e, a) = Just (e, Invoke a)+ g (_, _, Nothing, _) = Nothing+ ++-- | Handle drop-down menu events.+-- This should typically be called from the application event handler+-- if this menu widget has focus.+handleDropDownMenuEvent+ :: (Eq n, Ord n)+ => s+ -- ^ The application state+ -> Lens' s (DropDownMenu s n)+ -- ^ A lens for accessing the drop-down menu state+ -> (s -> s)+ -- ^ Sets focus to this drop-down menu widget if need be+ -> Event+ -- ^ Event received from Vty+ -> EventM n (Next s)+handleDropDownMenuEvent s target setFocus = \case+ EvKey KLeft [] -> continue $ s & target.menuList._Just %~ previous+ EvKey KRight [] -> continue $ s & target.menuList._Just %~ next+ EvKey KEsc [] -> continue $ s & target.menuOpen .~ False+ EvKey KUp []+ | s^.target.menuOpen &&+ fmap fst (listSelectedElement =<< s ^? target.submenuList) == Just 0 ->+ continue $ s & target.menuOpen .~ False+ EvKey KDown []+ | not $ s^.target.menuOpen ->+ continue $ s & target.menuOpen .~ True+ & target.submenuList %~ listMoveTo 0+ EvKey KEnter []+ | not $ s^.target.menuOpen -> continue $ s & target.menuOpen .~ True+ | otherwise ->+ case fmap snd (listSelectedElement =<< s ^? target.submenuList) of+ Nothing -> continue s+ Just (_, _, _, f) -> f s+ e | s^.target.menuOpen ->+ fromMaybe (continue =<< handleEventLensed s target handleSubmenuEvent e) $+ handleGlobalDropDownMenuEvent s target setFocus e+ | otherwise ->+ fromMaybe (continue s) $+ handleGlobalDropDownMenuEvent s target setFocus e++-- | Handle global events.+-- This function will handle global events associated with submenus+-- or menu items. It should typically be called from the main+-- application event handler before any other more specific handlers.+handleGlobalDropDownMenuEvent+ :: (Eq n, Ord n)+ => s+ -- ^ The application state+ -> Lens' s (DropDownMenu s n)+ -- ^ A lens for accessing the drop-down menu state+ -> (s -> s)+ -- ^ Set application focus+ -> Event+ -- ^ Event received from Vty+ -> Maybe (EventM n (Next s))+handleGlobalDropDownMenuEvent s target setFocus e = go =<< s ^. target . menuKeyMap . at e where+ go (MoveTo n) = case moveTo n =<< s ^. target.menuList of+ Nothing -> Nothing+ l -> pure . continue . setFocus $+ s & target.menuList .~ l+ & target.menuOpen .~ True+ go (Invoke f) = pure $ f s++renderDropDownMenu+ :: (Eq n, Ord n, Show n)+ => Bool+ -- ^ Does this menu have focus?+ -> DropDownMenu s n+ -> Widget n+renderDropDownMenu focused m = case m^?menuList._Just of+ Nothing -> emptyWidget+ Just menus ->+ let o = m^.menuOpen+ f ((t, l), sel) =+ let cursor = if focused && sel && not o+ then showCursor (getName l) (Location (0, 0))+ else id+ attr = if focused && sel && not o+ then withAttr menuSelectedAttr+ else id+ height = Vector.length $ listElements l+ width = maximum $ textWidth . showMenuItem <$> listElements l+ in if focused && sel && o+ then borderWithLabel (str t) $+ padLeftRight 1 $ vLimit height $ hLimit width $+ renderList drawMenuItem focused l+ else attr $ cursor $ str t+ in hBox $ intersperse (str " ") $ map f (toList (withFocus menus))++handleSubmenuEvent+ :: (Ord n)+ => Event+ -> DropDownMenu s n+ -> EventM n (DropDownMenu s n)+handleSubmenuEvent e m = maybe (pure m) handleEvent $ m ^? menuList._Just where+ handleEvent menus = do+ menus' <- handleEventLensed menus (focus._2) handleListEvent e+ pure $ m & menuList._Just .~ menus'++drawMenuItem :: Bool -> MenuItem s n -> Widget n+drawMenuItem sel x@(t, n, e, _) =+ let cursor = if sel then showCursor n (Location (0, 0)) else id+ in cursor $ str $ showMenuItem x++showMenuItem :: MenuItem s n -> String+showMenuItem (t, _, Just e, _) = t <> " (" <> showEvent e <> ")"+showMenuItem (t, _, Nothing, _) = t++showEvent :: Event -> String+showEvent (EvKey (KChar c) mods) = concatMap showModifier mods <> [c] where+ showModifier MCtrl = "Ctrl-"+ showModifier MMeta = "Meta-"+ showModifier MAlt = "Alt-"+ showModifier _ = ""++isDropDownMenuOpen :: DropDownMenu s n -> Bool+isDropDownMenuOpen = (^. menuOpen)++-- | Close submenu.+closeDropDownMenu :: DropDownMenu s n -> DropDownMenu s n+closeDropDownMenu = set menuOpen False++menuAttr, menuSelectedAttr :: AttrName+menuAttr = "dropdownmenu"+menuSelectedAttr = menuAttr <> "selected"