Core: make cropToContext also crop extents (fixes #101)

This change also:

* adds record fields to the Extent type
* adds a local coordinate offset to the Extent type for tracking the
  offset that the Extent's upper-left corner has into the original
  coordinate space of the Extent
* updates mouse event generation to account for the local offset when
  computing widget-local coordinates

src/Brick/Main.hs

@@ -238,30 +238,30 @@ runVty vty chan app appState rs = do
         VtyEvent (EvMouseDown c r button mods) -> do
             let matching = findClickedExtents_ (c, r) exts
             case matching of
-                (Extent n (Location (ec, er)) _:_) ->
+                (Extent n (Location (ec, er)) _ (Location (oC, oR)):_) ->
                     -- If the clicked extent was registered as
                     -- clickable, send a click event. Otherwise, just
                     -- send the raw mouse event
                     case n `elem` firstRS^.clickableNamesL of
                         True -> do
                             let localCoords = Location (lc, lr)
-                                lc = c - ec
+                                lc = c - ec + oC
-                                lr = r - er
+                                lr = r - er + oR
                             return (MouseDown n button mods localCoords, firstRS, exts)
                         False -> return (e, firstRS, exts)
                 _ -> return (e, firstRS, exts)
         VtyEvent (EvMouseUp c r button) -> do
             let matching = findClickedExtents_ (c, r) exts
             case matching of
-                (Extent n (Location (ec, er)) _:_) ->
+                (Extent n (Location (ec, er)) _ (Location (oC, oR)):_) ->
                     -- If the clicked extent was registered as
                     -- clickable, send a click event. Otherwise, just
                     -- send the raw mouse event
                     case n `elem` firstRS^.clickableNamesL of
                         True -> do
                             let localCoords = Location (lc, lr)
-                                lc = c - ec
+                                lc = c - ec + oC
-                                lr = r - er
+                                lr = r - er + oR
                             return (MouseUp n button localCoords, firstRS, exts)
                         False -> return (e, firstRS, exts)
                 _ -> return (e, firstRS, exts)
@@ -294,7 +294,7 @@ lookupViewport n = EventM $ asks (M.lookup n . eventViewportMap)
 -- | Did the specified mouse coordinates (column, row) intersect the
 -- specified extent?
 clickedExtent :: (Int, Int) -> Extent n -> Bool
-clickedExtent (c, r) (Extent _ (Location (lc, lr)) (w, h)) =
+clickedExtent (c, r) (Extent _ (Location (lc, lr)) (w, h) _) =
    c >= lc && c < (lc + w) &&
    r >= lr && r < (lr + h)
 
@@ -303,7 +303,7 @@ clickedExtent (c, r) (Extent _ (Location (lc, lr)) (w, h)) =
 lookupExtent :: (Eq n) => n -> EventM n (Maybe (Extent n))
 lookupExtent n = EventM $ asks (listToMaybe . filter f . latestExtents)
     where
-        f (Extent n' _ _) = n == n'
+        f (Extent n' _ _ _) = n == n'
 
 -- | Given a mouse click location, return the extents intersected by the
 -- click. The returned extents are sorted such that the first extent in

src/Brick/Types/Internal.hs

@@ -103,9 +103,12 @@ data EventState n = ES { esScrollRequests :: [(n, ScrollRequest)]
                        , cacheInvalidateRequests :: [CacheInvalidateRequest n]
                        }
 
--- | An extent of a named area indicating the location of its upper-left
+-- | An extent of a named area: its size, location, and origin.
--- corner and its size (width, height).
+data Extent n = Extent { extentName      :: n
-data Extent n = Extent n Location (Int, Int)
+                       , extentUpperLeft :: Location
+                       , extentSize      :: (Int, Int)
+                       , extentOffset    :: Location
+                       }
               deriving (Show)
 
 data EventRO n = EventRO { eventViewportMap :: M.Map n Viewport

src/Brick/Widgets/Core.hs

@@ -144,13 +144,15 @@ emptyWidget = raw V.emptyImage
 -- something and then translate it or otherwise offset it from its
 -- original origin.
 addResultOffset :: Location -> Result n -> Result n
-addResultOffset off = addCursorOffset off . addVisibilityOffset off . addExtentOffset off
+addResultOffset off = addCursorOffset off .
+                      addVisibilityOffset off .
+                      addExtentOffset off
 
 addVisibilityOffset :: Location -> Result n -> Result n
 addVisibilityOffset off r = r & visibilityRequestsL.each.vrPositionL %~ (off <>)
 
 addExtentOffset :: Location -> Result n -> Result n
-addExtentOffset off r = r & extentsL.each %~ (\(Extent n l sz) -> Extent n (off <> l) sz)
+addExtentOffset off r = r & extentsL.each %~ (\(Extent n l sz o) -> Extent n (off <> l) sz o)
 
 -- | Render the specified widget and record its rendering extent using
 -- the specified name (see also 'lookupExtent').
@@ -158,7 +160,7 @@ reportExtent :: n -> Widget n -> Widget n
 reportExtent n p =
     Widget (hSize p) (vSize p) $ do
         result <- render p
-        let ext = Extent n (Location (0, 0)) sz
+        let ext = Extent n (Location (0, 0)) sz (Location (0, 0))
             sz = ( result^.imageL.to V.imageWidth
                  , result^.imageL.to V.imageHeight
                  )

src/Brick/Widgets/Internal.hs

@@ -14,6 +14,7 @@ import Lens.Micro ((^.), (&), (%~))
 import Control.Monad.Trans.State.Lazy
 import Control.Monad.Trans.Reader
 import Data.Default
+import Data.Maybe (catMaybes)
 import qualified Graphics.Vty as V
 
 import Brick.Types
@@ -49,4 +50,58 @@ cropToContext p =
 cropResultToContext :: Result n -> RenderM n (Result n)
 cropResultToContext result = do
     c <- getContext
-    return $ result & imageL %~ (V.crop (max 0 $ c^.availWidthL) (max 0 $ c^.availHeightL))
+    return $ result & imageL   %~ cropImage   c
+                    & cursorsL %~ cropCursors c
+                    & extentsL %~ cropExtents c
+
+cropImage :: Context -> V.Image -> V.Image
+cropImage c = V.crop (max 0 $ c^.availWidthL) (max 0 $ c^.availHeightL)
+
+cropCursors :: Context -> [CursorLocation n] -> [CursorLocation n]
+cropCursors ctx cs = catMaybes $ cropCursor <$> cs
+    where
+        -- A cursor location is removed if it is not within the region
+        -- described by the context.
+        cropCursor c | outOfContext c = Nothing
+                     | otherwise      = Just c
+        outOfContext c =
+            or [ c^.cursorLocationL.locationRowL    < 0
+               , c^.cursorLocationL.locationColumnL < 0
+               , c^.cursorLocationL.locationRowL    >= ctx^.availHeightL
+               , c^.cursorLocationL.locationColumnL >= ctx^.availWidthL
+               ]
+
+cropExtents :: Context -> [Extent n] -> [Extent n]
+cropExtents ctx es = catMaybes $ cropExtent <$> es
+    where
+        -- An extent is cropped in places where it is not within the
+        -- region described by the context.
+        --
+        -- If its entirety is outside the context region, it is dropped.
+        --
+        -- Otherwise its size and upper left corner are adjusted so that
+        -- they are contained within the context region.
+        cropExtent (Extent n (Location (c, r)) (w, h) (Location (oC, oR))) =
+            -- First, clamp the upper-left corner to at least (0, 0).
+            let c' = max c 0
+                r' = max r 0
+                -- Compute deltas for the offset since if the upper-left
+                -- corner moved, so should the offset.
+                dc = c' - c
+                dr = r' - r
+                -- Then, determine the new lower-right corner based on
+                -- the clamped corner.
+                endCol = c' + w
+                endRow = r' + h
+                -- Then clamp the lower-right corner based on the
+                -- context
+                endCol' = min (ctx^.availWidthL) endCol
+                endRow' = min (ctx^.availHeightL) endRow
+                -- Then compute the new width and height from the
+                -- clamped lower-right corner.
+                w' = endCol' - c'
+                h' = endRow' - r'
+                e = Extent n (Location (c', r')) (w', h') (Location (oC + dc, oR + dr))
+            in if w' < 0 || h' < 0
+               then Nothing
+               else Just e