Don't use vertCat to combine images

Author: ali-abrar

src-bin/example.hs

@@ -65,7 +65,7 @@ main = mainWidget $ withCtrlC $ do
   initManager_ $ do
     tabNavigation
     let gf = grout . fixed
-        t = tile flex
+        t = tile (fixed 3)
         buttons = col $ do
           gf 3 $ col $ do
             gf 1 $ text "Select an example."
@@ -113,13 +113,19 @@ scrollingWithLayout
      , PerformEvent t m
      ) => m ()
 scrollingWithLayout = col $ do
-  scrollable def $ do
-    result <- boxTitle (constant def) (constant "Tracks") $ do
-      col $ forM [0..10] $ \n -> do
-        grout (fixed 1) $ do
-          textButtonStatic def $ T.pack (show n)
-        pure n
-    pure $ (never, result)
+  (s, x) <- tile flex $ boxTitle (constant def) (constant "Tracks") $ scrollable def $ do
+    result <- do
+      forM_ [(0::Int)..10] $ \n -> do
+        tile (fixed 5) $ do
+          tile (fixed 4) $ textButtonStatic def $ T.pack (show n)
+      askRegion
+    pure (never, result)
+  grout (fixed 1) $
+    text $ ("Total Lines: "<>) . T.pack . show <$> _scrollable_totalLines s
+  grout (fixed 1) $
+    text $ ("Scroll Pos: "<>) . T.pack . show <$> _scrollable_scrollPosition s
+  grout (fixed 1) $
+    text $ ("Scroll Height: "<>) . T.pack . show <$> _scrollable_scrollHeight s
   pure ()
 
 

src/Reflex/Vty/Widget/Scroll.hs

@@ -4,6 +4,7 @@ module Reflex.Vty.Widget.Scroll where
 
 import Control.Monad.Fix
 import Data.Default
+import Data.List (foldl')
 import qualified Graphics.Vty as V
 import Reflex
 import Reflex.Vty.Widget
@@ -55,8 +56,7 @@ scrollable
   -> m (Scrollable t, a)
 scrollable (ScrollableConfig scrollBy scrollTo startingPos onAppend) mkImg = do
   ((update, a), imgs) <- captureImages mkImg
-  let img = V.vertCat <$> imgs
-  let sz = V.imageHeight <$> img
+  let sz = foldl' max 0 . fmap V.imageHeight <$> imgs
   kup <- key V.KUp
   kdown <- key V.KDown
   m <- mouseScroll
@@ -84,15 +84,19 @@ scrollable (ScrollableConfig scrollBy scrollTo startingPos onAppend) mkImg = do
         _ -> Nothing) <$> tag onAppend update
     ]
   let imgsToTell height scrollPos totalLines images = case scrollPos of
-        ScrollPos_Bottom -> V.translateY ((-1) * max 0 (totalLines - height)) images
+        ScrollPos_Bottom -> cropFromTop ((1) * max 0 (totalLines - height)) <$> images
         ScrollPos_Top -> images -- take height images
-        ScrollPos_Line n -> V.translateY ((-1) * n) images
-  tellImages $ fmap (:[]) $ imgsToTell <$> current dh <*> current lineIndex <*> sz <*> img
+        ScrollPos_Line n -> cropFromTop ((1) * max 0 n) <$> images
+  tellImages $ imgsToTell <$> current dh <*> current lineIndex <*> sz <*> imgs
   return $ (,a) $ Scrollable
     { _scrollable_scrollPosition = current lineIndex
     , _scrollable_totalLines = sz
     , _scrollable_scrollHeight = current dh
     }
+  where
+    cropFromTop :: Int -> V.Image -> V.Image
+    cropFromTop rows i =
+      V.cropTop (max 0 $ V.imageHeight i - rows) i
 
 -- | Modify the scroll position by the given number of lines
 scrollByLines :: ScrollPos -> Int -> Int -> Int -> ScrollPos