Split.hs

-- |
--   Description: Widgets that split the display vertically or horizontally.
module Reflex.Vty.Widget.Split where

import Control.Monad.Fix
import Graphics.Vty as V
import Reflex

import Reflex.Vty.Widget
import Reflex.Vty.Widget.Input.Mouse

-- | A split of the available space into two parts with a draggable separator.
-- Starts with half the space allocated to each, and the first pane has focus.
-- Clicking in a pane switches focus.
splitVDrag
  :: (MonadFix m, MonadHold t m, HasDisplayRegion t m, HasInput t m, HasImageWriter t m, HasFocusReader t m)
  => m ()
  -> m a
  -> m b
  -> m (a, b)
splitVDrag wS wA wB = do
  dh <- viewportHeight
  dw <- viewportWidth
  dragE <- drag V.BLeft
  rec -- The divider's displayed position comes from the current
      -- height and the user-chosen fraction, never from a sampled
      -- initial height. While no drag has happened, the divider sits
      -- at half the height. The position is always clamped, so the
      -- divider row itself stays inside the viewport.
      let displayedPos =
            ( \h mf ->
                let raw = case mf of
                      Nothing -> h `div` 2
                      Just frac -> round (frac * fromIntegral (max 1 h))
                in min (max 0 raw) (max 0 (h - 1))
            )
              <$> dh
              <*> userFraction
          startsOnDivider =
            ffilter id $
              ffor (attach (current displayedPos) dragE) $
                \(p, Drag (_, fromY) _ _ _ st) -> st == DragStart && p == fromY
          dragEnded = ffilter (\d -> _drag_state d == DragEnd) dragE
      -- Drag ownership is decided at DragStart, against the pre-event
      -- divider position, and kept until DragEnd. Drags that start
      -- elsewhere are ignored.
      dragOwned <-
        holdDyn False $
          leftmost
            [ True <$ startsOnDivider
            , False <$ dragEnded
            ]
      userFraction <-
        holdDyn Nothing $
          fforMaybe (attach (current dragOwned) (attach (current dh) dragE)) $
            \(owned, (h, Drag _ (_, toY) _ _ _)) ->
              if not owned
                then Nothing
                else
                  Just
                    ( Just
                        ( fromIntegral (min (max 0 toY) (max 0 (h - 1)))
                            / max 1 (fromIntegral h)
                            :: Double
                        )
                    )
      let regA = Region 0 0 <$> dw <*> displayedPos
          regS = Region 0 <$> displayedPos <*> dw <*> 1
          regB = Region 0 <$> (displayedPos + 1) <*> dw <*> (dh - displayedPos - 1)
      focA <-
        holdDyn True $
          leftmost
            [ True <$ mA
            , False <$ mB
            ]
      (mA, rA) <- pane regA focA $ withMouseDown wA
      pane regS (pure False) wS
      (mB, rB) <- pane regB (not <$> focA) $ withMouseDown wB
  return (rA, rB)
  where
    withMouseDown x = do
      m <- mouseDown V.BLeft
      x' <- x
      return (m, x')

-- | A plain split of the available space into vertically stacked panes.
-- No visual separator is built in here.
splitV
  :: (MonadFix m, MonadHold t m, HasDisplayRegion t m, HasInput t m, HasImageWriter t m, HasFocusReader t m)
  => Dynamic t (Int -> Int)
  -- ^ Function used to determine size of first pane based on available size
  -> Dynamic t (Bool, Bool)
  -- ^ How to focus the two sub-panes, given that we are focused.
  -> m a
  -- ^ Widget for first pane
  -> m b
  -- ^ Widget for second pane
  -> m (a, b)
splitV sizeFunD focD wA wB = do
  dw <- viewportWidth
  dh <- viewportHeight
  let regA = Region 0 0 <$> dw <*> (sizeFunD <*> dh)
      regB = Region 0 <$> (_region_height <$> regA) <*> dw <*> liftA2 (-) dh (_region_height <$> regA)
  ra <- pane regA (fst <$> focD) wA
  rb <- pane regB (snd <$> focD) wB
  return (ra, rb)

-- | A plain split of the available space into horizontally stacked panes.
-- No visual separator is built in here.
splitH
  :: (MonadFix m, MonadHold t m, HasDisplayRegion t m, HasInput t m, HasImageWriter t m, HasFocusReader t m)
  => Dynamic t (Int -> Int)
  -- ^ Function used to determine size of first pane based on available size
  -> Dynamic t (Bool, Bool)
  -- ^ How to focus the two sub-panes, given that we are focused.
  -> m a
  -- ^ Widget for first pane
  -> m b
  -- ^ Widget for second pane
  -> m (a, b)
splitH sizeFunD focD wA wB = do
  dw <- viewportWidth
  dh <- viewportHeight
  let regA = Region 0 0 <$> (sizeFunD <*> dw) <*> dh
      regB = Region <$> (_region_width <$> regA) <*> 0 <*> liftA2 (-) dw (_region_width <$> regA) <*> dh
  liftA2 (,) (pane regA (fmap fst focD) wA) (pane regB (fmap snd focD) wB)