diff --git a/src/Glue.hs b/src/Glue.hs index a5e0469..10259f8 100644 --- a/src/Glue.hs +++ b/src/Glue.hs @@ -1,5 +1,6 @@ module Glue where import Brick +import Control.Monad (when) import Control.Monad.State.Lazy import States import StateManagement @@ -17,10 +18,16 @@ globalApp = App { appDraw = drawUI , appChooseCursor = showFirstCursor , appHandleEvent = handleEvent - , appStartEvent = return () + , appStartEvent = enableMouse , appAttrMap = handleAttrMap } +enableMouse = do + vty <- getVtyHandle + let output = V.outputIface vty + when (V.supportsMode output V.Mouse) $ + liftIO $ V.setMode output V.Mouse True + drawUI :: GlobalState -> [Widget Name] drawUI gs = case evalState getState gs of MainMenuState s -> MM.drawUI s diff --git a/src/Runners.hs b/src/Runners.hs index fa7a3ac..e0e6127 100644 --- a/src/Runners.hs +++ b/src/Runners.hs @@ -24,7 +24,7 @@ cardSelectorState = do let prettyRecents = shortenFilepaths (S.toList rs) options = Vec.fromList (prettyRecents ++ ["Select file from system"]) initialState = CSS - { _list = L.list Ordinary options 1 + { _list = L.list RecentsList options 1 , _exception = Nothing , _recents = rs , _maxRecentsToShow = maxRs } @@ -38,7 +38,7 @@ mainMenuState = , "Settings" , "Quit" ] - initialState = MMS (L.list Ordinary options 1) in + initialState = MMS (L.list MainMenuList options 1) in MainMenuState initialState safeHead :: [a] -> Maybe a @@ -93,7 +93,7 @@ infoState = InfoState () fileBrowserState :: IO State fileBrowserState = do - browser <- newFileBrowser selectNonDirectories Ordinary Nothing + browser <- newFileBrowser selectNonDirectories FileBrowserList Nothing let filteredBrowser = setFileBrowserEntryFilter (Just (entryFilter False)) browser return $ FileBrowserState (FBS filteredBrowser Nothing [] Nothing False) diff --git a/src/StateManagement.hs b/src/StateManagement.hs index 8c763f1..d1eeae1 100644 --- a/src/StateManagement.hs +++ b/src/StateManagement.hs @@ -136,4 +136,4 @@ refreshRecents = do let prettyRecents = shortenFilepaths (toList rs) options = Vec.fromList (prettyRecents ++ ["Select file from system"]) recents .= rs - list .= L.list Ordinary options 1 + list .= L.list RecentsList options 1 diff --git a/src/States.hs b/src/States.hs index 4087e44..ef1ffe7 100644 --- a/src/States.hs +++ b/src/States.hs @@ -11,6 +11,7 @@ import Lens.Micro.Platform import System.Random.MWC (GenIO) import Stack hiding (head) import Types +import qualified Brick.Types as T import qualified Data.List.NonEmpty as NE import qualified Data.Map.Strict as M import qualified Graphics.Vty as V @@ -33,6 +34,12 @@ data Name = | ParametersOkField | Ordinary + | MainMenuList + | InfoViewport + | SettingsViewport + | RecentsList + | FileBrowserList + | SBClick T.ClickableScrollbarElement Name deriving (Eq, Ord, Show) type Event = () diff --git a/src/UI/BrickHelpers.hs b/src/UI/BrickHelpers.hs index 4a38af6..e1e4aec 100644 --- a/src/UI/BrickHelpers.hs +++ b/src/UI/BrickHelpers.hs @@ -10,9 +10,11 @@ import Data.Maybe import Data.Text (pack) import Graphics.Vty (imageWidth, imageHeight, charFill) import Lens.Micro +import States (Name(SBClick)) import Text.Read (readMaybe) import UI.Attributes import qualified Graphics.Vty as V +import qualified Brick.Types as T hCenteredStrWrap :: String -> Widget n hCenteredStrWrap = hCenteredStrWrapWithAttr id @@ -122,3 +124,47 @@ renderNaturalNumber bound postfix n foc val = in if null postfix then hLimit (length (show bound)) (csr (addAttr (str val')) <+> hFill ' ') else csr (addAttr (str val')) <+> str postfix + +-- https://github.com/jtdaugherty/brick/issues/290#issuecomment-699570168 +fixedHeightOrViewport :: (Ord n, Show n) => Int -> n -> Widget n -> Widget n +fixedHeightOrViewport maxHeight vpName w = + Widget Fixed Fixed $ do + -- Render the viewport contents in advance + result <- render w + -- If the contents will fit in the maximum allowed rows, + -- just return the content without putting it in a viewport. + if imageHeight (image result) <= maxHeight + then return result + -- Otherwise put the contents (pre-rendered) in a viewport + -- and limit the height to the maximum allowable height. + else render (vLimit maxHeight $ + viewport vpName Vertical $ + Widget Fixed Fixed $ return result) + +fixedHeightOrViewportPercent :: (Ord n, Show n) => Int -> n -> Widget n -> Widget n +fixedHeightOrViewportPercent percentage vpName w = + Widget Fixed Fixed $ do + result <- render w + available <- availHeight <$> getContext + + if imageHeight (image result) <= percentage * available `div` 100 + then return result + else render (vLimitPercent percentage $ + viewport vpName Vertical w) + +handleClickScroll :: (Int -> EventM n s ()) -> ClickableScrollbarElement -> EventM n s () +handleClickScroll scroll el = + case el of + T.SBHandleBefore -> scroll (-1) + T.SBHandleAfter -> scroll 1 + T.SBTroughBefore -> scroll (-10) + T.SBTroughAfter -> scroll 10 + T.SBBar -> return () + +scrollableViewportPercent :: Int -> Name -> Widget Name -> Widget Name +scrollableViewportPercent percent n = + withClickableVScrollBars SBClick . + withVScrollBarHandles . + withVScrollBars OnRight . + fixedHeightOrViewportPercent percent n . + padRight (Pad 1) diff --git a/src/UI/Info.hs b/src/UI/Info.hs index 944f248..d3fe848 100644 --- a/src/UI/Info.hs +++ b/src/UI/Info.hs @@ -6,7 +6,9 @@ import Brick.Widgets.Border.Style import Brick.Widgets.Center import States import StateManagement +import qualified Brick.Types as T import qualified Graphics.Vty as V +import UI.BrickHelpers drawUI :: IS -> [Widget Name] drawUI = (:[]) . const ui @@ -22,17 +24,21 @@ ui = hBorder <=> drawInfo +scroll :: Int -> EventM Name s () +scroll = vScrollBy (viewportScroll InfoViewport) + handleEvent :: BrickEvent Name Event -> EventM Name GlobalState () -handleEvent (VtyEvent e) = +handleEvent (VtyEvent e) = do case e of V.EvKey V.KEsc [] -> popState V.EvKey (V.KChar 'q') [] -> popState V.EvKey V.KEnter [] -> popState - V.EvKey V.KDown [] -> vScrollBy (viewportScroll Ordinary) 1 - V.EvKey (V.KChar 'j') [] -> vScrollBy (viewportScroll Ordinary) 1 - V.EvKey V.KUp [] -> vScrollBy (viewportScroll Ordinary) (-1) - V.EvKey (V.KChar 'k') [] -> vScrollBy (viewportScroll Ordinary) (-1) + V.EvKey V.KDown [] -> scroll 1 + V.EvKey (V.KChar 'j') [] -> scroll 1 + V.EvKey V.KUp [] -> scroll (-1) + V.EvKey (V.KChar 'k') [] -> scroll (-1) _ -> return () +handleEvent (T.MouseDown (SBClick el InfoViewport) _ _ _) = handleClickScroll scroll el handleEvent _ = return () titleAttr :: AttrName @@ -44,9 +50,9 @@ theMap = attrMap V.defAttr drawInfo :: Widget Name drawInfo = - padLeftRight 1 $ - vLimitPercent 60 $ - viewport Ordinary Vertical (strWrap info) + padLeft (Pad 1) $ + scrollableViewportPercent 60 InfoViewport $ + strWrap info info :: String info = unlines diff --git a/src/UI/Settings.hs b/src/UI/Settings.hs index b0d1448..502e079 100644 --- a/src/UI/Settings.hs +++ b/src/UI/Settings.hs @@ -13,7 +13,9 @@ import Lens.Micro.Platform import States import StateManagement import Settings +import qualified Brick.Types as T import qualified Graphics.Vty as V +import UI.BrickHelpers (scrollableViewportPercent, handleClickScroll) drawUI :: SS -> [Widget Name] drawUI = (:[]) . ui @@ -27,9 +29,11 @@ ui f = hLimitPercent 60 $ hLimit 40 $ hCenter (withAttr titleAttr (str "Settings")) <=> - hBorder <=> - padLeftRight 1 - (renderForm f) + hBorder <=> + scrollableViewportPercent 60 SettingsViewport + (padLeft (Pad 1) $ renderForm f) + +scroll = vScrollBy (viewportScroll SettingsViewport) handleEvent :: BrickEvent Name Event -> EventM Name GlobalState () handleEvent ev@(VtyEvent e) = do @@ -37,12 +41,13 @@ handleEvent ev@(VtyEvent e) = do let halt' = popState <* liftIO (setSettings (formState form)) focus = formFocus form (Just n) = focusGetCurrent focus - down = unless (n == MaxRecentsField) $ + down = if n /= MaxRecentsField then ss .= form { formFocus = focusNext focus } + else scroll 1 up = unless (n == HintsField) $ ss .= form { formFocus = focusPrev focus } - + case e of V.EvKey V.KEsc [] -> halt' V.EvKey (V.KChar 'q') [] -> halt' @@ -54,4 +59,5 @@ handleEvent ev@(VtyEvent e) = do V.EvKey V.KBackTab [] -> return () _ -> zoom ss $ handleFormEvent ev +handleEvent (T.MouseDown (SBClick el SettingsViewport) _ _ _) = handleClickScroll scroll el handleEvent _ = return ()