Fix viewport scroll in main, info and settings menu & add scrollbars

Fixes:
- Scrolling in info screen scrolled main menu screen as well.
- Scrolling in settings menu is now possible
- Scroll bars have been added to info and settings menus. They can be scrolled with mouse clicks as well.

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

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)
 

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

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 = ()
 

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) 

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

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,22 +29,25 @@ 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
   form <- use ss
   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 ()