Get rid of scrolling wrappers, replace with viewport abstraction and primitives

brick.cabal

@@ -24,7 +24,6 @@ library
     Brick.List
     Brick.Main
     Brick.Render
-    Brick.Scroll
     Brick.Util
   other-modules:
     Brick.Render.Internal

programs/Main.hs

@@ -45,11 +45,11 @@ drawUI st = [a]
             vCenter $
               (hCenter $ borderWithLabel bs bsName $
                   (hLimit 25 (
-                    (vLimit 1 $ useAttr (cyan `on` blue) $ withLens stEditor drawEditor)
+                    (vLimit 1 $ useAttr (cyan `on` blue) $ drawEditor (st^.stEditor))
                     <<=
                     hBorder bs
                     =>>
-                    (vLimit 10 $ withLens stList drawList)
+                    (vLimit 10 $ drawList (st^.stList))
                   )))
               <<=
               (vLimit 1 $ vPad ' ')

src/Brick/Core.hs

@@ -1,18 +1,23 @@
+{-# LANGUAGE TemplateHaskell #-}
 module Brick.Core
-  ( Location(..)
+  ( Location(Location)
+  , loc
   , CursorName(..)
   , CursorLocation(..)
   , HandleEvent(..)
-  , SetSize(..)
   )
 where
 
+import Control.Lens
 import Data.Monoid (Monoid(..))
 import Graphics.Vty (Event, DisplayRegion)
 
-newtype Location = Location (Int, Int)
+data Location = Location { _loc :: (Int, Int)
+                         }
                 deriving Show
 
+makeLenses ''Location
+
 origin :: Location
 origin = Location (0, 0)
 
@@ -31,6 +36,3 @@ data CursorLocation =
 
 class HandleEvent a where
     handleEvent :: Event -> a -> a
-
-class SetSize a where
-    setSize :: DisplayRegion -> a -> a

src/Brick/Edit.hs

@@ -5,20 +5,17 @@ module Brick.Edit
   )
 where
 
-import Data.Default
 import Data.Monoid ((<>))
 import Graphics.Vty (Event(..), Key(..), Modifier(..))
 
-import Brick.Core (Location(..), CursorName(..), HandleEvent(..), SetSize(..))
+import Brick.Core (Location(..), CursorName(..), HandleEvent(..))
 import Brick.Render
-import Brick.Scroll (HScroll, hScroll, scrollToView)
 import Brick.Util (clamp)
 
 data Editor =
     Editor { editStr :: !String
            , editCursorPos :: !Int
            , editorCursorName :: !CursorName
-           , editorScroll :: !HScroll
            }
 
 instance HandleEvent Editor where
@@ -37,8 +34,7 @@ instance HandleEvent Editor where
 editSetCursorPos :: Int -> Editor -> Editor
 editSetCursorPos pos e =
     let newCP = clamp 0 (length $ editStr e) pos
-    in e { editorScroll = scrollToView (newCP, 1) (editorScroll e)
+    in e { editCursorPos = newCP
-         , editCursorPos = newCP
          }
 
 moveLeft :: Editor -> Editor
@@ -70,7 +66,6 @@ insertChar :: Char -> Editor -> Editor
 insertChar c theEdit =
     theEdit { editStr = s
             , editCursorPos = newCursorPos
-            , editorScroll = scrollToView (newCursorPos, 1) (editorScroll theEdit)
             }
     where
         s = take n oldStr ++ [c] ++ drop n oldStr
@@ -78,17 +73,22 @@ insertChar c theEdit =
         newCursorPos = n + 1
         oldStr = editStr theEdit
 
-instance SetSize Editor where
-    setSize sz e =
-        let updatedScroll = setSize sz $ editorScroll e
-        in e { editorScroll = scrollToView (editCursorPos e, 1) updatedScroll
-             }
-
 editor :: CursorName -> String -> Editor
-editor cName s = Editor s (length s) cName def
+editor cName s = Editor s (length s) cName
 
-drawEditor :: Render Editor
+drawEditor :: Editor -> Render Editor
-drawEditor =
+drawEditor e =
-    saveSize setSize $ hScroll editorScroll $ usingState $ \e ->
+    let cursorLoc = Location (cp, 0)
-      let cursorLoc = Location (editCursorPos e, 0)
+        cp = editCursorPos e
-      in showCursor (editorCursorName e) cursorLoc $ txt (editStr e) <<+ hPad ' '
+        s = editStr e
+        beforeCursor = take cp s
+        onCursor' = take 1 $ drop cp s
+        onCursor = if null onCursor' then " " else onCursor'
+        afterCursor = drop (cp + 1) s
+    in viewport "edit" Horizontal $
+       showCursor (editorCursorName e) cursorLoc $
+       hBox [ ( txt beforeCursor,         High )
+            , ( visible $ txt onCursor,   High )
+            , ( txt afterCursor,          High )
+            , ( hPad ' ',                 Low  )
+            ]

src/Brick/List.hs

@@ -11,24 +11,19 @@ module Brick.List
   )
 where
 
-import Control.Applicative ((<$>), (<|>))
+import Control.Applicative ((<$>))
-import Data.Default
+import Data.Maybe (fromMaybe)
-import Data.Maybe (fromMaybe, catMaybes)
+import Graphics.Vty (Event(..), Key(..))
-import Graphics.Vty (Event(..), Key(..), DisplayRegion)
-import qualified Data.Map as M
 
-import Brick.Core (HandleEvent(..), SetSize(..))
+import Brick.Core (HandleEvent(..))
 import Brick.Merge (maintainSel)
 import Brick.Render
-import Brick.Scroll (VScroll, vScroll, scrollToView)
 import Brick.Util (clamp, for)
 
 data List e =
     List { listElements :: ![e]
          , listElementDraw :: Bool -> e -> Render (List e)
          , listSelected :: !(Maybe Int)
-         , listScroll :: !VScroll
-         , listElementHeights :: M.Map Int Int
          }
 
 instance HandleEvent (List e) where
@@ -39,37 +34,25 @@ instance HandleEvent (List e) where
                   EvKey KDown [] -> moveDown
                   _ -> id
 
-instance SetSize (List e) where
-    setSize sz l =
-        let updatedScroll = setSize sz $ listScroll l
-        in makeSelectedVisible $ l { listScroll = updatedScroll }
-
 list :: (Bool -> e -> Render (List e)) -> [e] -> List e
 list draw es =
     let selIndex = if null es then Nothing else Just 0
-    in List es draw selIndex def M.empty
+    in List es draw selIndex
 
-listSetElementSize :: Int -> DisplayRegion -> List e -> List e
+drawList :: List e -> Render (List e)
-listSetElementSize i sz l =
+drawList l = theList
-    l { listElementHeights = M.insert i (snd sz) (listElementHeights l)
-      }
-
-drawList :: Render (List e)
-drawList = theList
     where
-        theList = saveSize setSize $
+        theList = viewport "list" Vertical $ body
-                  vScroll listScroll $
-                  ensure makeSelectedVisible body
 
-        body = usingState $ \l -> do
+        body = (vBox drawn <<= vPad ' ') <<+ hPad ' '
-                let es = listElements l
+        es = listElements l
         drawn = for (zip [0..] es) $ \(i, e) ->
             let isSelected = Just i == listSelected l
                 elemRender = listElementDraw l isSelected e
-                              in ( saveSize (listSetElementSize i) elemRender
+                makeVisible = if isSelected then visible else id
+            in ( makeVisible elemRender
                , High
                )
-                (vBox drawn <<= vPad ' ') <<+ hPad ' '
 
 listInsert :: Int -> e -> List e -> List e
 listInsert pos e l =
@@ -81,7 +64,7 @@ listInsert pos e l =
                     then s + 1
                     else s
         (front, back) = splitAt safePos es
-    in makeSelectedVisible $ l { listSelected = Just newSel
+    in l { listSelected = Just newSel
          , listElements = front ++ (e : back)
          }
 
@@ -96,7 +79,7 @@ listRemove pos l | null es = l
                      else s
         (front, back) = splitAt pos es
         es' = front ++ tail back
-    in makeSelectedVisible $ l { listSelected = if null es'
+    in l { listSelected = if null es'
                           then Nothing
                           else Just newSel
          , listElements = es'
@@ -114,7 +97,7 @@ listReplace es' l | es' == es = l
           (_, True)      -> Nothing
           (True, False)  -> Just 0
           (False, False) -> Just (maintainSel es es' sel)
-    in makeSelectedVisible $ l { listSelected = newSel
+    in l { listSelected = newSel
          , listElements = es'
          }
     where
@@ -129,13 +112,13 @@ moveDown = moveBy 1
 moveBy :: Int -> List e -> List e
 moveBy amt l =
     let newSel = clamp 0 (length (listElements l) - 1) <$> (amt +) <$> listSelected l
-    in makeSelectedVisible $ l { listSelected = newSel }
+    in l { listSelected = newSel }
 
 moveTo :: Int -> List e -> List e
 moveTo pos l =
     let len = length (listElements l)
         newSel = clamp 0 (len - 1) $ if pos < 0 then (len - pos) else pos
-    in makeSelectedVisible $ l { listSelected = if len > 0
+    in l { listSelected = if len > 0
                           then Just newSel
                           else Nothing
          }
@@ -144,14 +127,3 @@ listSelectedElement :: List e -> Maybe (Int, e)
 listSelectedElement l = do
   sel <- listSelected l
   return (sel, listElements l !! sel)
-
-makeSelectedVisible :: List e -> List e
-makeSelectedVisible l =
-    let Just scrollTo = (listSelected l) <|> (Just 0)
-        heights = listElementHeights l
-        scrollTop = sum $ catMaybes $ (\k -> M.lookup k heights) <$> [0..scrollTo-1]
-        scrollBottom = case M.lookup scrollTo heights of
-            Nothing -> 1
-            Just k -> k
-    in l { listScroll = scrollToView (scrollTop, scrollBottom) (listScroll l)
-         }

src/Brick/Main.hs

@@ -20,6 +20,7 @@ import Control.Monad (when, forever)
 import Control.Concurrent (forkIO, Chan, newChan, readChan, writeChan)
 import Data.Default
 import Data.Maybe (listToMaybe)
+import qualified Data.Map as M
 import Graphics.Vty
   ( Vty
   , Picture(..)
@@ -35,7 +36,7 @@ import Graphics.Vty
 import System.Exit (exitSuccess)
 
 import Brick.Render (Render)
-import Brick.Render.Internal (renderFinal)
+import Brick.Render.Internal (renderFinal, RenderState(..))
 import Brick.Core (Location(..), CursorLocation(..))
 
 data App a e =
@@ -61,11 +62,12 @@ simpleMain ls =
     in defaultMain app ()
 
 defaultMainWithVty :: IO Vty -> App a Event -> a -> IO ()
-defaultMainWithVty buildVty app initialState = do
+defaultMainWithVty buildVty app initialAppState = do
+    let initialRS = RS M.empty
     chan <- newChan
     withVty buildVty $ \vty -> do
         forkIO $ supplyVtyEvents vty id chan
-        runVty vty chan app initialState
+        runVty vty chan app initialAppState initialRS
 
 isResizeEvent :: Event -> Bool
 isResizeEvent (EvResize _ _) = True
@@ -80,28 +82,29 @@ supplyVtyEvents vty mkEvent chan =
         when (isResizeEvent e) $ writeChan chan $ mkEvent e
         writeChan chan $ mkEvent e
 
-runVty :: Vty -> Chan e -> App a e -> a -> IO ()
+runVty :: Vty -> Chan e -> App a e -> a -> RenderState -> IO ()
-runVty vty chan app appState = do
+runVty vty chan app appState rs = do
-    state' <- renderApp vty app appState
+    newRS <- renderApp vty app appState rs
     e <- readChan chan
-    appHandleEvent app e state' >>= runVty vty chan app
+    newAppState <- appHandleEvent app e appState
+    runVty vty chan app newAppState newRS
 
 withVty :: IO Vty -> (Vty -> IO a) -> IO a
 withVty buildVty useVty = do
     vty <- buildVty
     useVty vty `finally` shutdown vty
 
-renderApp :: Vty -> App a e -> a -> IO a
+renderApp :: Vty -> App a e -> a -> RenderState -> IO RenderState
-renderApp vty app appState = do
+renderApp vty app appState rs = do
     sz <- displayBounds $ outputIface vty
-    let (newAppState, pic, theCursor) = renderFinal (appDraw app appState) sz (appChooseCursor app appState) appState
+    let (newRS, pic, theCursor) = renderFinal (appDraw app appState) sz (appChooseCursor app appState) rs
         picWithCursor = case theCursor of
             Nothing -> pic { picCursor = NoCursor }
             Just (CursorLocation (Location (w, h)) _) -> pic { picCursor = Cursor w h }
 
     update vty picWithCursor
 
-    return newAppState
+    return newRS
 
 neverShowCursor :: a -> [CursorLocation] -> Maybe CursorLocation
 neverShowCursor = const $ const Nothing

src/Brick/Render.hs

@@ -3,6 +3,7 @@ module Brick.Render
   , Priority(..)
   , (=>>), (<<=), (<=>)
   , (+>>), (<<+), (<+>)
+  , ViewportType(..)
 
   , txt
   , hPad
@@ -21,12 +22,10 @@ module Brick.Render
   , cropTopBy
   , cropBottomBy
   , showCursor
-  , saveSize
   , hRelease
   , vRelease
-  , withLens
+  , viewport
-  , usingState
+  , visible
-  , ensure
   )
 where
 

src/Brick/Render/Internal.hs

@@ -8,10 +8,14 @@ module Brick.Render.Internal
   , image
   , cursors
 
+  , RenderState(..)
+
   , Priority(..)
   , renderFinal
   , Render
 
+  , ViewportType(..)
+
   , txt
   , hPad
   , vPad
@@ -29,33 +33,52 @@ module Brick.Render.Internal
   , cropTopBy
   , cropBottomBy
   , showCursor
-  , saveSize
   , hRelease
   , vRelease
-  , withLens
+  , viewport
-  , usingState
+  , visible
-  , ensure
   )
 where
 
 import Control.Applicative
-import Control.Lens (makeLenses, (^.), (.=), (.~), (&), (%~), to, _2)
+import Control.Lens (makeLenses, (^.), (.~), (&), (%~), to, _1, _2)
+import Control.Monad (when)
 import Control.Monad.Trans.State.Lazy
 import Control.Monad.Trans.Reader
 import Control.Monad.Trans.Class (lift)
 import Data.Default
+import Data.Monoid ((<>), mempty)
+import qualified Data.Map as M
 import qualified Data.Function as DF
 import Data.List (sortBy)
 import Control.Lens (Lens')
 import Data.String (IsString(..))
 import qualified Graphics.Vty as V
 
-import Brick.Core (Location(..), CursorLocation(..), CursorName(..))
+import Brick.Core (Location(..), loc, CursorLocation(..), CursorName(..))
 import Brick.Util (clOffset, for)
 
+import qualified Debug.Trace as D
+
+data VisibilityRequest =
+    VR { _vrPosition :: Location
+       , _vrSize :: V.DisplayRegion
+       }
+       deriving Show
+
+data ViewportType = Vertical | Horizontal deriving Show
+
+data Viewport =
+    VP { _vpLeft :: Int
+       , _vpTop :: Int
+       , _vpSize :: V.DisplayRegion
+       }
+       deriving Show
+
 data Result =
     Result { _image :: V.Image
            , _cursors :: [CursorLocation]
+           , _visibilityRequests :: [VisibilityRequest]
            }
            deriving Show
 
@@ -65,33 +88,45 @@ data Context =
             , _h :: Int
             }
 
-makeLenses ''Result
-makeLenses ''Context
-
 data Priority = High | Low
               deriving (Show, Eq)
 
-type Render a = ReaderT Context (State a) Result
+type Render a = ReaderT Context (State RenderState) Result
+
+data RenderState =
+    RS { _viewportMap :: M.Map String Viewport
+       }
+
+makeLenses ''Result
+makeLenses ''Context
+makeLenses ''VisibilityRequest
+makeLenses ''Viewport
+makeLenses ''RenderState
 
 instance IsString (Render a) where
     fromString = txt
 
 instance Default Result where
-    def = Result V.emptyImage []
+    def = Result V.emptyImage [] []
 
 renderFinal :: [Render a]
             -> V.DisplayRegion
             -> ([CursorLocation] -> Maybe CursorLocation)
-            -> a
+            -> RenderState
-            -> (a, V.Picture, Maybe CursorLocation)
+            -> (RenderState, V.Picture, Maybe CursorLocation)
-renderFinal layerRenders sz chooseCursor st = (newState, pic, theCursor)
+renderFinal layerRenders sz chooseCursor rs = (newRS, pic, theCursor)
     where
-        (layerResults, newState) = flip runState st $ sequence $ (\p -> runReaderT p ctx) <$> layerRenders
+        (layerResults, newRS) = flip runState rs $ sequence $ (\p -> runReaderT p ctx) <$> layerRenders
         ctx = Context V.defAttr (fst sz) (snd sz)
         pic = V.picForLayers $ uncurry V.resize sz <$> (^.image) <$> layerResults
         layerCursors = (^.cursors) <$> layerResults
         theCursor = chooseCursor $ concat layerCursors
 
+addVisibilityOffset :: Location -> Result -> Result
+addVisibilityOffset off r =
+    let addOffset vrs = (& vrPosition %~ (off <>)) <$> vrs
+    in r & visibilityRequests %~ addOffset
+
 addCursorOffset :: Location -> Result -> Result
 addCursorOffset off r =
     let onlyVisible = filter isVisible
@@ -155,12 +190,16 @@ hBox pairs = do
         allResults = snd <$> rendered
         allImages = (^.image) <$> allResults
         allWidths = V.imageWidth <$> allImages
+        allTranslatedVRs = for (zip [0..] allResults) $ \(i, result) ->
+            let off = Location (offWidth, 0)
+                offWidth = sum $ take i allWidths
+            in (addVisibilityOffset off result)^.visibilityRequests
         allTranslatedCursors = for (zip [0..] allResults) $ \(i, result) ->
             let off = Location (offWidth, 0)
                 offWidth = sum $ take i allWidths
             in (addCursorOffset off result)^.cursors
 
-    return $ Result (V.horizCat allImages) (concat allTranslatedCursors)
+    return $ Result (V.horizCat allImages) (concat allTranslatedCursors) (concat allTranslatedVRs)
 
 vBox :: [(Render a, Priority)] -> Render a
 vBox pairs = do
@@ -189,18 +228,22 @@ vBox pairs = do
         allResults = snd <$> rendered
         allImages = (^.image) <$> allResults
         allHeights = V.imageHeight <$> allImages
+        allTranslatedVRs = for (zip [0..] allResults) $ \(i, result) ->
+            let off = Location (0, offHeight)
+                offHeight = sum $ take i allHeights
+            in (addVisibilityOffset off result)^.visibilityRequests
         allTranslatedCursors = for (zip [0..] allResults) $ \(i, result) ->
             let off = Location (0, offHeight)
                 offHeight = sum $ take i allHeights
             in (addCursorOffset off result)^.cursors
 
-    return $ Result (V.vertCat allImages) (concat allTranslatedCursors)
+    return $ Result (V.vertCat allImages) (concat allTranslatedCursors) (concat allTranslatedVRs)
 
--- xxx crop cursors
+-- xxx crop cursors and VRs
 hLimit :: Int -> Render a -> Render a
 hLimit w' = withReaderT (& w .~ w')
 
--- xxx crop cursors
+-- xxx crop cursors and VRs
 vLimit :: Int -> Render a -> Render a
 vLimit h' = withReaderT (& h .~ h')
 
@@ -219,6 +262,7 @@ translate (Location (tw,th)) p = do
     result <- p
     c <- ask
     return $ addCursorOffset (Location (tw, th)) $
+             addVisibilityOffset (Location (tw, th)) $
              result & image %~ (V.crop (c^.w) (c^.h) . V.translate tw th)
 
 cropLeftBy :: Int -> Render a -> Render a
@@ -226,14 +270,16 @@ cropLeftBy cols p = do
     result <- p
     let amt = V.imageWidth (result^.image) - cols
         cropped img = if amt < 0 then V.emptyImage else V.cropLeft amt img
-    return $ addCursorOffset (Location (-1 * cols, 0)) $ result & image %~ cropped
+    return $ addCursorOffset (Location (-1 * cols, 0)) $
+             addVisibilityOffset (Location (-1 * cols, 0)) $
+             result & image %~ cropped
 
 cropRightBy :: Int -> Render a -> Render a
 cropRightBy cols p = do
     result <- p
     let amt = V.imageWidth (result^.image) - cols
         cropped img = if amt < 0 then V.emptyImage else V.cropRight amt img
-    -- xxx cursors
+    -- xxx cursors / VRs
     return $ result & image %~ cropped
 
 cropTopBy :: Int -> Render a -> Render a
@@ -241,28 +287,22 @@ cropTopBy rows p = do
     result <- p
     let amt = V.imageHeight (result^.image) - rows
         cropped img = if amt < 0 then V.emptyImage else V.cropTop amt img
-    return $ addCursorOffset (Location (0, -1 * rows)) $ result & image %~ cropped
+    return $ addCursorOffset (Location (0, -1 * rows)) $
+             addVisibilityOffset (Location (0, -1 * rows)) $
+             result & image %~ cropped
 
 cropBottomBy :: Int -> Render a -> Render a
 cropBottomBy rows p = do
     result <- p
     let amt = V.imageHeight (result^.image) - rows
         cropped img = if amt < 0 then V.emptyImage else V.cropBottom amt img
-    -- xxx crop cursors
+    -- xxx crop cursors / VRs
     return $ result & image %~ cropped
 
 showCursor :: CursorName -> Location -> Render a -> Render a
-showCursor n loc p = do
+showCursor n cloc p = do
     result <- p
-    return $ result & cursors %~ (CursorLocation loc (Just n):)
+    return $ result & cursors %~ (CursorLocation cloc (Just n):)
-
-saveSize :: (V.DisplayRegion -> a -> a) -> Render a -> Render a
-saveSize sizeSetter p = do
-    result <- p
-    let img = result^.image
-        imgSz = (V.imageWidth img, V.imageHeight img)
-    lift $ modify (sizeSetter imgSz)
-    return result
 
 hRelease :: Render a -> Render a
 hRelease = withReaderT (& w .~ unrestricted) --- NB
@@ -270,20 +310,79 @@ hRelease = withReaderT (& w .~ unrestricted) --- NB
 vRelease :: Render a -> Render a
 vRelease = withReaderT (& h .~ unrestricted) --- NB
 
-withLens :: (Lens' a b) -> Render b -> Render a
+viewport :: String -> ViewportType -> Render a -> Render a
-withLens target p = do
+viewport vpname typ p = do
-    outerState <- lift get
+    -- First, update the viewport size.
-    let oldInnerState = outerState^.target
     c <- ask
-    let (result, newInnerState) = runState (runReaderT p c) oldInnerState
+    let newVp = VP 0 0 newSize
-    target .= newInnerState
+        newSize = (c^.w, c^.h)
-    return result
+        doInsert (Just vp) = Just $ vp & vpSize .~ newSize
+        doInsert Nothing = Just newVp
 
-usingState :: (a -> Render a) -> Render a
+    lift $ modify (& viewportMap %~ (M.alter doInsert vpname))
-usingState f = (lift get) >>= (\a -> f a)
 
-ensure :: (a -> a) -> Render a -> Render a
+    -- Then render the sub-rendering with the rendering layout
-ensure f p = do
+    -- constraint released
+    let release = case typ of
+          Vertical -> vRelease
+          Horizontal -> hRelease
+
+    initialResult <- release p
+
+    -- If the sub-rendering requested visibility, update the scroll
+    -- state accordingly
+    when (not $ null $ initialResult^.visibilityRequests) $ do
+        Just vp <- lift $ gets $ (^.viewportMap.to (M.lookup vpname))
+        -- XXX for now, just permit one request but we could permit
+        -- many by computing the bounding rectangle over the submitted
+        -- requests.
+        let [rq] = initialResult^.visibilityRequests
+            updatedVp = scrollToView typ rq vp
+        lift $ D.trace (show (vpname, rq, newVp)) $ modify (& viewportMap %~ (M.insert vpname updatedVp))
+
+    -- Get the viewport state now that it has been updated.
+    Just vp <- lift $ gets (M.lookup vpname . (^.viewportMap))
+
+    -- Then perform a translation of the sub-rendering to fit into the
+    -- viewport
+    translated <- translate (Location (-1 * vp^.vpLeft, -1 * vp^.vpTop)) $ return initialResult
+
+    -- Return the translated result with the visibility requests
+    -- discarded
+    return $ translated & visibilityRequests .~ mempty
+
+scrollToView :: ViewportType -> VisibilityRequest -> Viewport -> Viewport
+scrollToView typ rq vp = vp & theStart .~ newStart
+    where
+        theStart :: Lens' Viewport Int
+        theStart = case typ of
+            Horizontal -> vpLeft
+            Vertical -> vpTop
+        theSize = case typ of
+            Horizontal -> vpSize._1
+            Vertical -> vpSize._2
+        reqStart = case typ of
+            Horizontal -> rq^.vrPosition.loc._1
+            Vertical -> rq^.vrPosition.loc._2
+        reqSize = case typ of
+            Horizontal -> rq^.vrSize._1
+            Vertical -> rq^.vrSize._2
+
+        curStart = vp^.theStart
+        curEnd = curStart + vp^.theSize
+
+        reqEnd = reqStart + reqSize
+        newStart :: Int
+        newStart = if reqStart < curStart
+                   then reqStart
+                   else if reqStart > curEnd || reqEnd > curEnd
+                        then reqEnd - vp^.theSize
+                        else curStart
+
+visible :: Render a -> Render a
+visible p = do
     result <- p
-    lift $ modify f
+    let imageSize = ( result^.image.to V.imageWidth
-    return result
+                    , result^.image.to V.imageHeight
+                    )
+    return $ result & visibilityRequests %~ (VR (Location (0, 0)) imageSize :)

src/Brick/Scroll.hs

@@ -1,81 +0,0 @@
-module Brick.Scroll
-  ( Scrollable(..)
-
-  , VScroll
-  , vScroll
-
-  , HScroll
-  , hScroll
-
-  , scrollToView
-  )
-where
-
-import Data.Default
-
-import Brick.Core (SetSize(..), Location(..))
-import Brick.Render
-
-data HScroll =
-    HScroll { scrollLeft :: !Int
-            , scrollWidth :: !Int
-            }
-
-data VScroll =
-    VScroll { scrollTop :: !Int
-            , scrollHeight :: !Int
-            }
-
-instance SetSize VScroll where
-    setSize (_, h) vs = vs { scrollHeight = h }
-
-instance SetSize HScroll where
-    setSize (w, _) hs = hs { scrollWidth = w }
-
-instance Default HScroll where
-    def = HScroll 0 0
-
-instance Default VScroll where
-    def = VScroll 0 0
-
-class Scrollable a where
-    setScrollStart :: Int -> a -> a
-    scrollStart :: a -> Int
-    scrollSize :: a -> Int
-
-instance Scrollable HScroll where
-    setScrollStart col hs = hs { scrollLeft = col }
-    scrollStart = scrollLeft
-    scrollSize = scrollWidth
-
-instance Scrollable VScroll where
-    setScrollStart row vs = vs { scrollTop = row }
-    scrollStart = scrollTop
-    scrollSize = scrollHeight
-
-vScroll :: (a -> VScroll) -> Render a -> Render a
-vScroll f p = do
-    result <- vRelease p
-    usingState $ \s ->
-        let vs = f s
-        in translate (Location (0, -1 * scrollStart vs)) $ return result
-
-hScroll :: (a -> HScroll) -> Render a -> Render a
-hScroll f p = do
-    result <- hRelease p
-    usingState $ \s ->
-        let hs = f s
-        in translate (Location (-1 * scrollStart hs, 0)) $ return result
-
-scrollToView :: (Scrollable a) => (Int, Int) -> a -> a
-scrollToView (reqStart, reqSize) s =
-    setScrollStart newStart s
-    where
-        curEnd = curStart + scrollSize s
-        curStart = scrollStart s
-        reqEnd = reqStart + reqSize
-        newStart = if reqStart < curStart
-                   then reqStart
-                   else if reqStart > curEnd || reqEnd > curEnd
-                        then reqEnd - scrollSize s
-                        else curStart