WIP: Revert inputInFocusedRegion; Add mkTile so that custom pane functions can be used to build layouts

ChangeLog.md

@@ -1,5 +1,13 @@
 # Revision history for reflex-vty
 
+## 0.6.0.0
+
+* *Breaking change:*
+  * Reverted the behavior of `inputInFocusedRegion` to simply filter mouse events to those that occur within the display region of a widget. It no longer attempts to track mouse drag events that occur outside the region that are part of a drag that started inside the region.
+  * To recover the previous behavior, you can use the new `mkPane` function with `inputStartedInFocusedRegion` to construct a pane that does the drag-tracking described above. To use that pane in a tile, use `mkTile (mkPane inputStartedInFocusedRegion)`
+  * Change `inputStartedInFocusedRegion` to filter mouse scroll wheel input based on if the region is in focus rather than mouse drag tracking
+* Added `mkTile` and `mkPane`
+
 ## 0.5.0.0
 
 * *Breaking change*:
@@ -9,7 +17,6 @@
 * `scrollableText` can be configured to remain scrolled to the bottom on new output, either always or whenever the user is scrolled to the bottom and new output appears.
 * Added a new `scrollable` widget in `Reflex.Vty.Widget.Scroll` that allows vertical scrolling when an `Image` is taller than the widget's height.
 * Add `ctrlc`, a convenience function that returns an event that fires when a Ctrl+c keypress is detected
-* Change `inputInFocusedRegion` to filter mouse scroll wheel input based on if the region is in focus rather than mouse drag tracking
 * Fix several issues with wide chars, cursor position and word wrapping in Zipper.hs
 * Add `centerText` function to Reflex.Vty.Widget.Box
 

reflex-vty.cabal

@@ -1,5 +1,5 @@
 name: reflex-vty
-version: 0.5.0.0
+version: 0.6.0.0
 synopsis: Reflex FRP host and widgets for VTY applications
 description:
   Build terminal applications using functional reactive programming (FRP) with Reflex FRP (<https://reflex-frp.org>).

src/Reflex/Vty/Widget.hs

@@ -6,7 +6,7 @@
 
 module Reflex.Vty.Widget where
 
 import Control.Applicative (liftA2)
 import Control.Monad.Fix (MonadFix)
 import Control.Monad.IO.Class (MonadIO)
 import Control.Monad.Morph (MFunctor(..))
@@ -202,6 +202,21 @@
       | otherwise =
         Just (con (x - l) (y - t))
 
+-- | Filter mouse input outside the current display region and
+-- all input if the region is not focused
+inputInFocusedRegion
+  :: (HasDisplayRegion t m, HasFocusReader t m, HasInput t m)
+  => m (Event t VtyEvent)
+inputInFocusedRegion = do
+  inp <- input
+  reg <- current <$> askRegion
+  foc <- current <$> focus
+  pure $ fmapMaybe id $ attachWith filterInput ((,) <$> reg <*> foc) inp
+  where
+    filterInput (r, f) = \case
+      V.EvKey {} | not f -> Nothing
+      x -> mouseInRegion r x
+
 -- |
 -- * 'Tracking' state means actively tracking the current stream of mouse events
 -- * 'NotTracking' state means not tracking the current stream of mouse events
@@ -214,10 +229,10 @@
 -- mouse input is reported if the mouse is in the region
 -- EXCEPT mouse drag sequences that start OFF the region are NOT reported
 -- AND mouse drag sequences that start ON the region and drag off ARE reported
-inputInFocusedRegion
+inputStartedInFocusedRegion
   :: forall t m. (MonadFix m, MonadHold t m, HasDisplayRegion t m, HasFocusReader t m, HasInput t m)
   => m (Event t VtyEvent)
-inputInFocusedRegion = do
+inputStartedInFocusedRegion = do
   inp <- input
   regBeh <- current <$> askRegion
   foc <- current <$> focus
@@ -237,9 +252,9 @@
         V.EvKey _ _ | not focused -> Nothing
 
         -- filter scroll wheel input based on mouse position
-        x@(V.EvMouseDown _ _ btn _) | btn == V.BScrollUp || btn == V.BScrollDown -> case tracking of
+        e@(V.EvMouseDown x y btn _) | btn == V.BScrollUp || btn == V.BScrollDown -> case tracking of
           trck@(Tracking _) -> Just (trck, Nothing)
-          _ -> Just (WaitingForInput, if focused then Just x else Nothing)
+          _ -> Just (WaitingForInput, if withinRegion reg x y then Just e else Nothing)
 
         -- only do tracking for l/m/r mouse buttons
         V.EvMouseDown x y btn m ->
@@ -600,8 +615,6 @@
 -- * unfocused widgets receive no key events
 -- * mouse inputs inside the region have their coordinates translated such
 --   that (0,0) is the top-left corner of the region
--- * mouse drag sequences that start OFF the region are ignored
--- * mouse drag sequences that start ON the region and drag off are NOT ignored
 pane
   :: (MonadFix m, MonadHold t m, HasInput t m, HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m)
   => Dynamic t Region
@@ -613,6 +626,19 @@
     localFocus (const foc) $
       inputInFocusedRegion >>= \e -> localInput (const e) child
 
+-- | Build a pane with a custom event source
+mkPane
+  :: (MonadFix m, MonadHold t m, HasInput t m, HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m)
+  => m (Event t VtyEvent)
+  -> Dynamic t Region
+  -> Dynamic t Bool -- ^ Whether the widget should be focused when the parent is.
+  -> m a
+  -> m a
+mkPane f dr foc child = localRegion (const dr) $
+  mapImages (imagesInRegion $ current dr) $
+    localFocus (const foc) $
+      f >>= \e -> localInput (const e) child
+
 -- * Misc
 
 -- | A widget that draws nothing

src/Reflex/Vty/Widget/Layout.hs

@@ -6,7 +6,7 @@
 
 module Reflex.Vty.Widget.Layout where
 
 import Control.Applicative (liftA2)
 import Control.Monad.Morph
 import Control.Monad.NodeId (MonadNodeId(..), NodeId)
 import Control.Monad.Fix
@@ -507,26 +507,35 @@
 
 -- *** Focusable
 
--- | A widget that is focusable and occupies a layout region based on the
--- provided constraint. Returns the 'FocusId' allowing for manual focus
--- management.
-tile'
+-- |
+mkTile
   :: (MonadFix m, MonadHold t m, HasInput t m, HasFocus t m, HasLayout t m, HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m)
-  => Dynamic t Constraint
+  => (forall a. Dynamic t Region -> Dynamic t Bool -> m a -> m a)
+  -> Dynamic t Constraint
   -> m a
   -> m (FocusId, a)
-tile' c w = do
+mkTile customPane c w = do
   fid <- makeFocus
   r <- region c
   parentFocused <- isFocused fid
-  rec (click, result, childFocused) <- pane r focused $ anyChildFocused $ \childFoc -> do
+  rec (click, result, childFocused) <- customPane r focused $ anyChildFocused $ \childFoc -> do
         m <- mouseDown V.BLeft
         x <- w
         pure (m, x, childFoc)
       let focused = (||) <$> parentFocused <*> childFocused
   requestFocus $ Refocus_Id fid <$ click
   pure (fid, result)
 
+-- | A widget that is focusable and occupies a layout region based on the
+-- provided constraint. Returns the 'FocusId' allowing for manual focus
+-- management.
+tile'
+  :: (MonadFix m, MonadHold t m, HasInput t m, HasFocus t m, HasLayout t m, HasImageWriter t m, HasDisplayRegion t m, HasFocusReader t m)
+  => Dynamic t Constraint
+  -> m a
+  -> m (FocusId, a)
+tile' = mkTile pane
+
 -- | A widget that is focusable and occupies a layout region based on the
 -- provided constraint.
 tile