{-# LANGUAGE LambdaCase #-}

-- | Pure pane-grid tree model and geometry, modelled on iced's @PaneGrid@.
--
-- A 'GridNode' is a binary split tree of panes. Each split stores an axis
-- ('AxisV' = vertical divider splitting width, 'AxisH' = horizontal divider
-- splitting height), a ratio in @[0,1]@ for the first (A) side, and the two
-- child subtrees. Every pane and split has a globally unique 'Word64' id so
-- pane state can be keyed by pane id regardless of position in the tree.
--
-- All functions here are pure; the interactive wrapper in
-- "NanoUI.Widgets.PaneGrid" persists a 'GridNode' as a "Data.Dynamic" value
-- in the widget store.
module NanoUI.Widgets.SplitPane
  ( GridAxis (..)
  , GridNode (..)
  , PaneDrop (..)
  , treePanes
  , treeSize
  , paneExist
  , subtreeMin
  , mainMins
  , mainLen
  , splitLength
  , layoutNode
  , DividerInfo (..)
  , treeSplit
  , treeSetRatio
  , treeRemovePane
  , treeMovePane
  , clampTreeRatio
  , dropPreview
  , dropTargetForPane
  , topLevelDropTarget
  ) where

import Control.Applicative ((<|>))
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Word (Word64)
import NanoUI.Types (Rect (..), V2 (..), clamp, clamp01, rectH, rectNonEmpty, rectW, rectX, rectY)

-- | Divider orientation. 'AxisV' draws a vertical divider (panes left/right),
-- 'AxisH' draws a horizontal divider (panes stacked top/bottom).
data GridAxis = AxisV | AxisH
  deriving (GridAxis -> GridAxis -> Bool
(GridAxis -> GridAxis -> Bool)
-> (GridAxis -> GridAxis -> Bool) -> Eq GridAxis
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GridAxis -> GridAxis -> Bool
== :: GridAxis -> GridAxis -> Bool
$c/= :: GridAxis -> GridAxis -> Bool
/= :: GridAxis -> GridAxis -> Bool
Eq, Eq GridAxis
Eq GridAxis =>
(GridAxis -> GridAxis -> Ordering)
-> (GridAxis -> GridAxis -> Bool)
-> (GridAxis -> GridAxis -> Bool)
-> (GridAxis -> GridAxis -> Bool)
-> (GridAxis -> GridAxis -> Bool)
-> (GridAxis -> GridAxis -> GridAxis)
-> (GridAxis -> GridAxis -> GridAxis)
-> Ord GridAxis
GridAxis -> GridAxis -> Bool
GridAxis -> GridAxis -> Ordering
GridAxis -> GridAxis -> GridAxis
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GridAxis -> GridAxis -> Ordering
compare :: GridAxis -> GridAxis -> Ordering
$c< :: GridAxis -> GridAxis -> Bool
< :: GridAxis -> GridAxis -> Bool
$c<= :: GridAxis -> GridAxis -> Bool
<= :: GridAxis -> GridAxis -> Bool
$c> :: GridAxis -> GridAxis -> Bool
> :: GridAxis -> GridAxis -> Bool
$c>= :: GridAxis -> GridAxis -> Bool
>= :: GridAxis -> GridAxis -> Bool
$cmax :: GridAxis -> GridAxis -> GridAxis
max :: GridAxis -> GridAxis -> GridAxis
$cmin :: GridAxis -> GridAxis -> GridAxis
min :: GridAxis -> GridAxis -> GridAxis
Ord, Int -> GridAxis -> ShowS
[GridAxis] -> ShowS
GridAxis -> String
(Int -> GridAxis -> ShowS)
-> (GridAxis -> String) -> ([GridAxis] -> ShowS) -> Show GridAxis
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GridAxis -> ShowS
showsPrec :: Int -> GridAxis -> ShowS
$cshow :: GridAxis -> String
show :: GridAxis -> String
$cshowList :: [GridAxis] -> ShowS
showList :: [GridAxis] -> ShowS
Show, Int -> GridAxis
GridAxis -> Int
GridAxis -> [GridAxis]
GridAxis -> GridAxis
GridAxis -> GridAxis -> [GridAxis]
GridAxis -> GridAxis -> GridAxis -> [GridAxis]
(GridAxis -> GridAxis)
-> (GridAxis -> GridAxis)
-> (Int -> GridAxis)
-> (GridAxis -> Int)
-> (GridAxis -> [GridAxis])
-> (GridAxis -> GridAxis -> [GridAxis])
-> (GridAxis -> GridAxis -> [GridAxis])
-> (GridAxis -> GridAxis -> GridAxis -> [GridAxis])
-> Enum GridAxis
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: GridAxis -> GridAxis
succ :: GridAxis -> GridAxis
$cpred :: GridAxis -> GridAxis
pred :: GridAxis -> GridAxis
$ctoEnum :: Int -> GridAxis
toEnum :: Int -> GridAxis
$cfromEnum :: GridAxis -> Int
fromEnum :: GridAxis -> Int
$cenumFrom :: GridAxis -> [GridAxis]
enumFrom :: GridAxis -> [GridAxis]
$cenumFromThen :: GridAxis -> GridAxis -> [GridAxis]
enumFromThen :: GridAxis -> GridAxis -> [GridAxis]
$cenumFromTo :: GridAxis -> GridAxis -> [GridAxis]
enumFromTo :: GridAxis -> GridAxis -> [GridAxis]
$cenumFromThenTo :: GridAxis -> GridAxis -> GridAxis -> [GridAxis]
enumFromThenTo :: GridAxis -> GridAxis -> GridAxis -> [GridAxis]
Enum, GridAxis
GridAxis -> GridAxis -> Bounded GridAxis
forall a. a -> a -> Bounded a
$cminBound :: GridAxis
minBound :: GridAxis
$cmaxBound :: GridAxis
maxBound :: GridAxis
Bounded)

-- | Binary split tree node. Pane and split ids share one monotonic counter.
-- Positional (non-record) so the multi-constructor type keeps total fields.
data GridNode
  = Split
      !Word64
      -- ^ Split id.
      !GridAxis
      -- ^ Orientation of the divider.
      !Float
      -- ^ Ratio in @[0,1]@ for the A side.
      !GridNode
      -- ^ Left / top subtree.
      !GridNode
      -- ^ Right / bottom subtree.
  | Pane
      !Word64
      -- ^ Pane id.
  deriving (GridNode -> GridNode -> Bool
(GridNode -> GridNode -> Bool)
-> (GridNode -> GridNode -> Bool) -> Eq GridNode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GridNode -> GridNode -> Bool
== :: GridNode -> GridNode -> Bool
$c/= :: GridNode -> GridNode -> Bool
/= :: GridNode -> GridNode -> Bool
Eq, Int -> GridNode -> ShowS
[GridNode] -> ShowS
GridNode -> String
(Int -> GridNode -> ShowS)
-> (GridNode -> String) -> ([GridNode] -> ShowS) -> Show GridNode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GridNode -> ShowS
showsPrec :: Int -> GridNode -> ShowS
$cshow :: GridNode -> String
show :: GridNode -> String
$cshowList :: [GridNode] -> ShowS
showList :: [GridNode] -> ShowS
Show)

-- | Result of dropping a dragged pane on a target pane.
data PaneDrop
  = DropSwap Word64
      -- ^ Drop on the center of the pane: the two panes swap places.
  | DropSplit Word64 GridAxis Bool
      -- ^ Drop near an edge: the target pane splits along the axis and the
      -- dragged pane moves into the new child. 'True' puts the dragged pane on
      -- the A (left/top) side, 'False' on the B (right/bottom) side.
  | DropTop GridAxis Bool
      -- ^ Drop on the outer edge of the whole grid: the entire tree is wrapped
      -- in a new top-level split and the dragged pane takes one side, so the
      -- rest of the grid collapses onto the other. 'True' puts the dragged
      -- pane on the A (left/top) side, 'False' on the B (right/bottom) side.
  deriving (PaneDrop -> PaneDrop -> Bool
(PaneDrop -> PaneDrop -> Bool)
-> (PaneDrop -> PaneDrop -> Bool) -> Eq PaneDrop
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PaneDrop -> PaneDrop -> Bool
== :: PaneDrop -> PaneDrop -> Bool
$c/= :: PaneDrop -> PaneDrop -> Bool
/= :: PaneDrop -> PaneDrop -> Bool
Eq, Int -> PaneDrop -> ShowS
[PaneDrop] -> ShowS
PaneDrop -> String
(Int -> PaneDrop -> ShowS)
-> (PaneDrop -> String) -> ([PaneDrop] -> ShowS) -> Show PaneDrop
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PaneDrop -> ShowS
showsPrec :: Int -> PaneDrop -> ShowS
$cshow :: PaneDrop -> String
show :: PaneDrop -> String
$cshowList :: [PaneDrop] -> ShowS
showList :: [PaneDrop] -> ShowS
Show)

-- | Fold a tree bottom-up: @onPane@ for each pane id, @onSplit@ for each
-- split (id, axis, ratio) with its already-folded A and B sides. The sides
-- are passed lazily, so a short-circuiting @onSplit@ stops early.
foldGrid :: (Word64 -> r) -> (Word64 -> GridAxis -> Float -> r -> r -> r) -> GridNode -> r
foldGrid :: forall r.
(Word64 -> r)
-> (Word64 -> GridAxis -> Float -> r -> r -> r) -> GridNode -> r
foldGrid Word64 -> r
onPane Word64 -> GridAxis -> Float -> r -> r -> r
onSplit = GridNode -> r
go
  where
    go :: GridNode -> r
go (Pane Word64
pid) = Word64 -> r
onPane Word64
pid
    go (Split Word64
sid GridAxis
axis Float
ratio GridNode
a GridNode
b) = Word64 -> GridAxis -> Float -> r -> r -> r
onSplit Word64
sid GridAxis
axis Float
ratio (GridNode -> r
go GridNode
a) (GridNode -> r
go GridNode
b)

-- | Pane ids in the tree (depth-first, A then B).
treePanes :: GridNode -> [Word64]
treePanes :: GridNode -> [Word64]
treePanes = (Word64 -> [Word64])
-> (Word64
    -> GridAxis -> Float -> [Word64] -> [Word64] -> [Word64])
-> GridNode
-> [Word64]
forall r.
(Word64 -> r)
-> (Word64 -> GridAxis -> Float -> r -> r -> r) -> GridNode -> r
foldGrid Word64 -> [Word64]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (\Word64
_ GridAxis
_ Float
_ [Word64]
a [Word64]
b -> [Word64]
a [Word64] -> [Word64] -> [Word64]
forall a. Semigroup a => a -> a -> a
<> [Word64]
b)

-- | Number of panes.
treeSize :: GridNode -> Int
treeSize :: GridNode -> Int
treeSize = (Word64 -> Int)
-> (Word64 -> GridAxis -> Float -> Int -> Int -> Int)
-> GridNode
-> Int
forall r.
(Word64 -> r)
-> (Word64 -> GridAxis -> Float -> r -> r -> r) -> GridNode -> r
foldGrid (Int -> Word64 -> Int
forall a b. a -> b -> a
const Int
1) (\Word64
_ GridAxis
_ Float
_ Int
a Int
b -> Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b)

-- | Does a pane with the given id exist?
paneExist :: GridNode -> Word64 -> Bool
paneExist :: GridNode -> Word64 -> Bool
paneExist GridNode
t Word64
p = (Word64 -> Bool)
-> (Word64 -> GridAxis -> Float -> Bool -> Bool -> Bool)
-> GridNode
-> Bool
forall r.
(Word64 -> r)
-> (Word64 -> GridAxis -> Float -> r -> r -> r) -> GridNode -> r
foldGrid (Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
p) (\Word64
_ GridAxis
_ Float
_ Bool
a Bool
b -> Bool
a Bool -> Bool -> Bool
|| Bool
b) GridNode
t

-- | Minimum (width, height) that must be reserved for a subtree under a
-- 'minSize' per-pane floor and 'spacing' between every split level.
subtreeMin :: Float -> Float -> GridNode -> (Float, Float)
subtreeMin :: Float -> Float -> GridNode -> (Float, Float)
subtreeMin Float
minSize Float
spacing = \case
  Pane Word64
_ -> (Float
minSize, Float
minSize)
  Split Word64
_ GridAxis
axis Float
_ GridNode
a GridNode
b ->
    let (Float
wa, Float
ha) = Float -> Float -> GridNode -> (Float, Float)
subtreeMin Float
minSize Float
spacing GridNode
a
        (Float
wb, Float
hb) = Float -> Float -> GridNode -> (Float, Float)
subtreeMin Float
minSize Float
spacing GridNode
b
     in case GridAxis
axis of
          GridAxis
AxisV -> (Float
wa Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
spacing Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
wb, Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
ha Float
hb)
          GridAxis
AxisH -> (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
wa Float
wb, Float
ha Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
spacing Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
hb)

-- | Extent of a region along a split's main axis.
mainLen :: GridAxis -> Rect -> Float
mainLen :: GridAxis -> Rect -> Float
mainLen GridAxis
AxisV = Rect -> Float
rectW
mainLen GridAxis
AxisH = Rect -> Float
rectH

-- | The subtree minima that apply along a split's main axis: widths for
-- 'AxisV' (panes left/right), heights for 'AxisH' (panes stacked).
mainMins :: GridAxis -> (Float, Float) -> (Float, Float) -> (Float, Float)
mainMins :: GridAxis -> (Float, Float) -> (Float, Float) -> (Float, Float)
mainMins GridAxis
AxisV (Float
wa, Float
_) (Float
wb, Float
_) = (Float
wa, Float
wb)
mainMins GridAxis
AxisH (Float
_, Float
ha) (Float
_, Float
hb) = (Float
ha, Float
hb)

-- | A-side extent for a split along its main axis, honouring the subtree
-- minima. The ratio shares out the extent left after the gutter between the
-- sides, so a 0.5 split gives both sides the same length. Falls back to the
-- raw share when the region is too small to satisfy both minima.
splitLength :: Float -> Float -> Float -> Float -> Float -> Float
splitLength :: Float -> Float -> Float -> Float -> Float -> Float
splitLength Float
spacing Float
avail Float
minA Float
minB Float
ratio
  | Float
avail Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0 = Float
0
  | Float
lo Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
hi = Float -> Float -> Float -> Float
forall a. Ord a => a -> a -> a -> a
clamp Float
lo Float
hi Float
share
  | Bool
otherwise = Float -> Float -> Float -> Float
forall a. Ord a => a -> a -> a -> a
clamp Float
0 Float
avail Float
share
  where
    share :: Float
share = Float
ratio Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float
avail Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
spacing)
    lo :: Float
lo = Float
minA
    hi :: Float
hi = Float
avail Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
spacing Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
minB

-- | Carve a region at offset @d@ along the main axis into (A, B, divider band).
splitBounds :: GridAxis -> Float -> Rect -> Float -> (Rect, Rect, Rect)
splitBounds :: GridAxis -> Float -> Rect -> Float -> (Rect, Rect, Rect)
splitBounds GridAxis
AxisV Float
spacing Rect
r Float
d =
  let avail :: Float
avail = Rect -> Float
rectW Rect
r
   in ( Rect
r {rectW = d}
      , Rect
r {rectX = rectX r + d + spacing, rectW = avail - d - spacing}
      , Float -> Float -> Float -> Float -> Rect
Rect (Rect -> Float
rectX Rect
r Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
d) (Rect -> Float
rectY Rect
r) Float
spacing (Rect -> Float
rectH Rect
r)
      )
splitBounds GridAxis
AxisH Float
spacing Rect
r Float
d =
  let avail :: Float
avail = Rect -> Float
rectH Rect
r
   in ( Rect
r {rectH = d}
      , Rect
r {rectY = rectY r + d + spacing, rectH = avail - d - spacing}
      , Float -> Float -> Float -> Float -> Rect
Rect (Rect -> Float
rectX Rect
r) (Rect -> Float
rectY Rect
r Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
d) (Rect -> Float
rectW Rect
r) Float
spacing
      )

-- | Per-split divider information: the split's own region (where the ratio
-- applies), the exact spacing band, and the axis / ratio / id.
data DividerInfo = DividerInfo
  { DividerInfo -> Word64
diSplitId :: {-# UNPACK #-} !Word64
  , DividerInfo -> GridAxis
diAxis :: !GridAxis
  , DividerInfo -> Rect
diRegion :: !Rect
  , DividerInfo -> Rect
diBand :: !Rect
  , DividerInfo -> Float
diRatio :: {-# UNPACK #-} !Float
  }
  deriving (DividerInfo -> DividerInfo -> Bool
(DividerInfo -> DividerInfo -> Bool)
-> (DividerInfo -> DividerInfo -> Bool) -> Eq DividerInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DividerInfo -> DividerInfo -> Bool
== :: DividerInfo -> DividerInfo -> Bool
$c/= :: DividerInfo -> DividerInfo -> Bool
/= :: DividerInfo -> DividerInfo -> Bool
Eq, Int -> DividerInfo -> ShowS
[DividerInfo] -> ShowS
DividerInfo -> String
(Int -> DividerInfo -> ShowS)
-> (DividerInfo -> String)
-> ([DividerInfo] -> ShowS)
-> Show DividerInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DividerInfo -> ShowS
showsPrec :: Int -> DividerInfo -> ShowS
$cshow :: DividerInfo -> String
show :: DividerInfo -> String
$cshowList :: [DividerInfo] -> ShowS
showList :: [DividerInfo] -> ShowS
Show)

-- | Lay out a tree into per-pane regions and divider bands within 'Rect'.
-- Dividers are reported parent-before-child so dragging a divider resizes its
-- immediate subtrees relative to the same region.
layoutNode :: Float -> Float -> GridNode -> Rect -> (Map Word64 Rect, [DividerInfo])
layoutNode :: Float
-> Float -> GridNode -> Rect -> (Map Word64 Rect, [DividerInfo])
layoutNode Float
minSize Float
spacing GridNode
sp Rect
r =
  case GridNode
sp of
    Pane Word64
pid -> (Word64 -> Rect -> Map Word64 Rect
forall k a. k -> a -> Map k a
M.singleton Word64
pid Rect
r, [])
    Split Word64
sid GridAxis
axis Float
ratio0 GridNode
a GridNode
b ->
      let (Float
wa, Float
ha) = Float -> Float -> GridNode -> (Float, Float)
subtreeMin Float
minSize Float
spacing GridNode
a
          (Float
wb, Float
hb) = Float -> Float -> GridNode -> (Float, Float)
subtreeMin Float
minSize Float
spacing GridNode
b
          (Float
mA, Float
mB) = GridAxis -> (Float, Float) -> (Float, Float) -> (Float, Float)
mainMins GridAxis
axis (Float
wa, Float
ha) (Float
wb, Float
hb)
          (Rect
rA, Rect
rB, Rect
band) = GridAxis -> Float -> Rect -> Float -> (Rect, Rect, Rect)
splitBounds GridAxis
axis Float
spacing Rect
r (Float -> Float -> Float -> Float -> Float -> Float
splitLength Float
spacing (GridAxis -> Rect -> Float
mainLen GridAxis
axis Rect
r) Float
mA Float
mB Float
ratio0)
          self :: DividerInfo
self = Word64 -> GridAxis -> Rect -> Rect -> Float -> DividerInfo
DividerInfo Word64
sid GridAxis
axis Rect
r Rect
band Float
ratio0
          (Map Word64 Rect
regionsA, [DividerInfo]
divsA) = Float
-> Float -> GridNode -> Rect -> (Map Word64 Rect, [DividerInfo])
layoutNode Float
minSize Float
spacing GridNode
a Rect
rA
          (Map Word64 Rect
regionsB, [DividerInfo]
divsB) = Float
-> Float -> GridNode -> Rect -> (Map Word64 Rect, [DividerInfo])
layoutNode Float
minSize Float
spacing GridNode
b Rect
rB
       in (Map Word64 Rect -> Map Word64 Rect -> Map Word64 Rect
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Map Word64 Rect
regionsA Map Word64 Rect
regionsB, DividerInfo
self DividerInfo -> [DividerInfo] -> [DividerInfo]
forall a. a -> [a] -> [a]
: [DividerInfo]
divsA [DividerInfo] -> [DividerInfo] -> [DividerInfo]
forall a. Semigroup a => a -> a -> a
<> [DividerInfo]
divsB)

-- | Split the pane (first arg) along the axis with a 0.5 ratio, inserting the
-- new pane. 'newOnA' places the new pane on the A (left/top) side of the new
-- split; 'False' puts it on the B (right/bottom) side. Returns the updated
-- tree (unchanged if the pane does not exist).
treeSplit :: Word64 -> Word64 -> GridAxis -> Bool -> Word64 -> GridNode -> GridNode
treeSplit :: Word64
-> Word64 -> GridAxis -> Bool -> Word64 -> GridNode -> GridNode
treeSplit Word64
targetPaneId Word64
splitId GridAxis
axis Bool
newOnA Word64
newPaneId = (Word64 -> GridNode)
-> (Word64
    -> GridAxis -> Float -> GridNode -> GridNode -> GridNode)
-> GridNode
-> GridNode
forall r.
(Word64 -> r)
-> (Word64 -> GridAxis -> Float -> r -> r -> r) -> GridNode -> r
foldGrid Word64 -> GridNode
onPane Word64 -> GridAxis -> Float -> GridNode -> GridNode -> GridNode
Split
  where
    onPane :: Word64 -> GridNode
onPane Word64
p
      | Word64
p Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
targetPaneId = Word64 -> GridNode
Pane Word64
p
      | Bool
newOnA = Word64 -> GridAxis -> Float -> GridNode -> GridNode -> GridNode
Split Word64
splitId GridAxis
axis Float
0.5 (Word64 -> GridNode
Pane Word64
newPaneId) (Word64 -> GridNode
Pane Word64
p)
      | Bool
otherwise = Word64 -> GridAxis -> Float -> GridNode -> GridNode -> GridNode
Split Word64
splitId GridAxis
axis Float
0.5 (Word64 -> GridNode
Pane Word64
p) (Word64 -> GridNode
Pane Word64
newPaneId)

-- | Set the raw ratio of a split (clamped to @[0,1]@).
treeSetRatio :: Word64 -> Float -> GridNode -> GridNode
treeSetRatio :: Word64 -> Float -> GridNode -> GridNode
treeSetRatio Word64
splitId Float
r =
  (Word64 -> GridNode)
-> (Word64
    -> GridAxis -> Float -> GridNode -> GridNode -> GridNode)
-> GridNode
-> GridNode
forall r.
(Word64 -> r)
-> (Word64 -> GridAxis -> Float -> r -> r -> r) -> GridNode -> r
foldGrid Word64 -> GridNode
Pane (\Word64
sid GridAxis
ax Float
r0 -> Word64 -> GridAxis -> Float -> GridNode -> GridNode -> GridNode
Split Word64
sid GridAxis
ax (if Word64
sid Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
splitId then Float -> Float
clamp01 Float
r else Float
r0))

-- | Remove a pane. The sibling subtree absorbs its space. @Nothing@ if the
-- pane does not exist or removing it would empty the tree.
treeRemovePane :: Word64 -> GridNode -> Maybe GridNode
treeRemovePane :: Word64 -> GridNode -> Maybe GridNode
treeRemovePane Word64
pid = (Word64 -> Maybe GridNode)
-> (Word64
    -> GridAxis
    -> Float
    -> Maybe GridNode
    -> Maybe GridNode
    -> Maybe GridNode)
-> GridNode
-> Maybe GridNode
forall r.
(Word64 -> r)
-> (Word64 -> GridAxis -> Float -> r -> r -> r) -> GridNode -> r
foldGrid Word64 -> Maybe GridNode
onPane Word64
-> GridAxis
-> Float
-> Maybe GridNode
-> Maybe GridNode
-> Maybe GridNode
onSplit
  where
    onPane :: Word64 -> Maybe GridNode
onPane Word64
p = if Word64
p Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
pid then Maybe GridNode
forall a. Maybe a
Nothing else GridNode -> Maybe GridNode
forall a. a -> Maybe a
Just (Word64 -> GridNode
Pane Word64
p)
    onSplit :: Word64
-> GridAxis
-> Float
-> Maybe GridNode
-> Maybe GridNode
-> Maybe GridNode
onSplit Word64
sid GridAxis
ax Float
r0 Maybe GridNode
ma Maybe GridNode
mb = case (Maybe GridNode
ma, Maybe GridNode
mb) of
      (Just GridNode
a, Just GridNode
b) -> GridNode -> Maybe GridNode
forall a. a -> Maybe a
Just (Word64 -> GridAxis -> Float -> GridNode -> GridNode -> GridNode
Split Word64
sid GridAxis
ax Float
r0 GridNode
a GridNode
b)
      (Maybe GridNode
Nothing, Maybe GridNode
b) -> Maybe GridNode
b
      (Maybe GridNode
a, Maybe GridNode
Nothing) -> Maybe GridNode
a

-- | Swap two panes by id (content follows the pane id).
treeSwapPanes :: Word64 -> Word64 -> GridNode -> GridNode
treeSwapPanes :: Word64 -> Word64 -> GridNode -> GridNode
treeSwapPanes Word64
a Word64
b = (Word64 -> GridNode)
-> (Word64
    -> GridAxis -> Float -> GridNode -> GridNode -> GridNode)
-> GridNode
-> GridNode
forall r.
(Word64 -> r)
-> (Word64 -> GridAxis -> Float -> r -> r -> r) -> GridNode -> r
foldGrid (\Word64
p -> Word64 -> GridNode
Pane (if Word64
p Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
a then Word64
b else if Word64
p Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
b then Word64
a else Word64
p)) Word64 -> GridAxis -> Float -> GridNode -> GridNode -> GridNode
Split

-- | Move a pane onto a drop target. Center drops swap the two panes; edge
-- drops split the target pane with the given fresh split id and move the
-- dragged pane into the new child; top-level drops wrap the whole tree in a
-- new root split with the dragged pane on one side.
treeMovePane :: Word64 -> Word64 -> PaneDrop -> GridNode -> Maybe GridNode
treeMovePane :: Word64 -> Word64 -> PaneDrop -> GridNode -> Maybe GridNode
treeMovePane Word64
moved Word64
splitId PaneDrop
dt GridNode
tree
  | Bool -> Bool
not (GridNode -> Word64 -> Bool
paneExist GridNode
tree Word64
moved) = Maybe GridNode
forall a. Maybe a
Nothing
  | Bool
otherwise =
      case PaneDrop
dt of
        DropSwap Word64
tgt
          | Word64
tgt Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
moved -> Maybe GridNode
forall a. Maybe a
Nothing
          | Bool -> Bool
not (GridNode -> Word64 -> Bool
paneExist GridNode
tree Word64
tgt) -> Maybe GridNode
forall a. Maybe a
Nothing
          | Bool
otherwise -> GridNode -> Maybe GridNode
forall a. a -> Maybe a
Just (Word64 -> Word64 -> GridNode -> GridNode
treeSwapPanes Word64
moved Word64
tgt GridNode
tree)
        DropSplit Word64
tgt GridAxis
axis Bool
onA
          | Word64
tgt Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
moved -> Maybe GridNode
forall a. Maybe a
Nothing
          | Bool -> Bool
not (GridNode -> Word64 -> Bool
paneExist GridNode
tree Word64
tgt) -> Maybe GridNode
forall a. Maybe a
Nothing
          | Bool
otherwise -> do
              t' <- Word64 -> GridNode -> Maybe GridNode
treeRemovePane Word64
moved GridNode
tree
              Just (treeSplit tgt splitId axis onA moved t')
        DropTop GridAxis
axis Bool
onA
          | GridNode -> Int
treeSize GridNode
tree Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 -> Maybe GridNode
forall a. Maybe a
Nothing
          | Bool
otherwise -> do
              t' <- Word64 -> GridNode -> Maybe GridNode
treeRemovePane Word64
moved GridNode
tree
              Just
                ( if onA
                    then Split splitId axis 0.5 (Pane moved) t'
                    else Split splitId axis 0.5 t' (Pane moved)
                )

-- | Find the split node with a given id (or 'Nothing').
findSplitNode :: GridNode -> Word64 -> Maybe GridNode
findSplitNode :: GridNode -> Word64 -> Maybe GridNode
findSplitNode (Pane Word64
_) Word64
_ = Maybe GridNode
forall a. Maybe a
Nothing
findSplitNode s :: GridNode
s@(Split Word64
sid0 GridAxis
_ Float
_ GridNode
a GridNode
b) Word64
target
  | Word64
sid0 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
target = GridNode -> Maybe GridNode
forall a. a -> Maybe a
Just GridNode
s
  | Bool
otherwise = GridNode -> Word64 -> Maybe GridNode
findSplitNode GridNode
a Word64
target Maybe GridNode -> Maybe GridNode -> Maybe GridNode
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> GridNode -> Word64 -> Maybe GridNode
findSplitNode GridNode
b Word64
target

-- | Clamp a proposed ratio for a split so both subtrees keep at least their
-- minimum size within the given region.
clampTreeRatio :: GridNode -> Word64 -> Rect -> Float -> Float -> Float -> Float
clampTreeRatio :: GridNode -> Word64 -> Rect -> Float -> Float -> Float -> Float
clampTreeRatio GridNode
tree Word64
splitId Rect
region Float
spacing Float
minSize Float
r0 =
  case GridNode -> Word64 -> Maybe GridNode
findSplitNode GridNode
tree Word64
splitId of
    Maybe GridNode
Nothing -> Float
r0
    Just (Pane Word64
_) -> Float
r0
    Just (Split Word64
_ GridAxis
ax Float
_ GridNode
a GridNode
b) ->
      let avail :: Float
avail = GridAxis -> Rect -> Float
mainLen GridAxis
ax Rect
region
          usable :: Float
usable = Float
avail Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
spacing
       in if Float
usable Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0
            then Float
r0
            else
              let (Float
wa, Float
ha) = Float -> Float -> GridNode -> (Float, Float)
subtreeMin Float
minSize Float
spacing GridNode
a
                  (Float
wb, Float
hb) = Float -> Float -> GridNode -> (Float, Float)
subtreeMin Float
minSize Float
spacing GridNode
b
                  (Float
mA, Float
mB) = GridAxis -> (Float, Float) -> (Float, Float) -> (Float, Float)
mainMins GridAxis
ax (Float
wa, Float
ha) (Float
wb, Float
hb)
               in Float -> Float -> Float -> Float -> Float -> Float
splitLength Float
spacing Float
avail Float
mA Float
mB Float
r0 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
usable

-- | Which drop zone a pointer falls into for a target pane rect.
data EdgeZone = ZoneCenter | ZoneLeft | ZoneRight | ZoneTop | ZoneBottom

-- | Classify a drop point into a zone of the target pane.
edgeZone :: Rect -> V2 -> EdgeZone
edgeZone :: Rect -> V2 -> EdgeZone
edgeZone Rect
r (V2 Float
mx Float
my)
  | Bool -> Bool
not (Rect -> Bool
rectNonEmpty Rect
r) = EdgeZone
ZoneCenter
  | Float
tx Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0.25 = EdgeZone
ZoneLeft
  | Float
tx Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0.75 = EdgeZone
ZoneRight
  | Float
ty Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0.25 = EdgeZone
ZoneTop
  | Float
ty Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0.75 = EdgeZone
ZoneBottom
  | Bool
otherwise = EdgeZone
ZoneCenter
  where
    tx :: Float
tx = (Float
mx Float -> Float -> Float
forall a. Num a => a -> a -> a
- Rect -> Float
rectX Rect
r) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Rect -> Float
rectW Rect
r
    ty :: Float
ty = (Float
my Float -> Float -> Float
forall a. Num a => a -> a -> a
- Rect -> Float
rectY Rect
r) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Rect -> Float
rectH Rect
r

-- | Classify a drop point on a target pane into the 'PaneDrop' the drop
-- performs: the pane's center swaps the two panes, an edge zone splits the
-- target along that edge's axis with the dragged pane on the near side.
dropTargetForPane :: Rect -> V2 -> Word64 -> PaneDrop
dropTargetForPane :: Rect -> V2 -> Word64 -> PaneDrop
dropTargetForPane Rect
r V2
mouse Word64
tgt =
  case Rect -> V2 -> EdgeZone
edgeZone Rect
r V2
mouse of
    EdgeZone
ZoneCenter -> Word64 -> PaneDrop
DropSwap Word64
tgt
    EdgeZone
ZoneLeft -> Word64 -> GridAxis -> Bool -> PaneDrop
DropSplit Word64
tgt GridAxis
AxisV Bool
True
    EdgeZone
ZoneRight -> Word64 -> GridAxis -> Bool -> PaneDrop
DropSplit Word64
tgt GridAxis
AxisV Bool
False
    EdgeZone
ZoneTop -> Word64 -> GridAxis -> Bool -> PaneDrop
DropSplit Word64
tgt GridAxis
AxisH Bool
True
    EdgeZone
ZoneBottom -> Word64 -> GridAxis -> Bool -> PaneDrop
DropSplit Word64
tgt GridAxis
AxisH Bool
False

-- | Classify a drop point against the grid's outer boundary. If the pointer
-- sits within @band@ px of a grid edge, return the 'DropTop' target for that
-- edge; otherwise 'Nothing'. Checked before pane-level drops so the outermost
-- edge always restructures the whole grid.
topLevelDropTarget :: Float -> Rect -> V2 -> Maybe PaneDrop
topLevelDropTarget :: Float -> Rect -> V2 -> Maybe PaneDrop
topLevelDropTarget Float
band r :: Rect
r@(Rect Float
l Float
t Float
w Float
h) (V2 Float
x Float
y)
  | Bool -> Bool
not (Rect -> Bool
rectNonEmpty Rect
r) = Maybe PaneDrop
forall a. Maybe a
Nothing
  | Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
l Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
band = PaneDrop -> Maybe PaneDrop
forall a. a -> Maybe a
Just (GridAxis -> Bool -> PaneDrop
DropTop GridAxis
AxisV Bool
True)
  | Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
l Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
w Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
band = PaneDrop -> Maybe PaneDrop
forall a. a -> Maybe a
Just (GridAxis -> Bool -> PaneDrop
DropTop GridAxis
AxisV Bool
False)
  | Float
y Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
t Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
band = PaneDrop -> Maybe PaneDrop
forall a. a -> Maybe a
Just (GridAxis -> Bool -> PaneDrop
DropTop GridAxis
AxisH Bool
True)
  | Float
y Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
t Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
h Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
band = PaneDrop -> Maybe PaneDrop
forall a. a -> Maybe a
Just (GridAxis -> Bool -> PaneDrop
DropTop GridAxis
AxisH Bool
False)
  | Bool
otherwise = Maybe PaneDrop
forall a. Maybe a
Nothing

-- | Drop preview for a drop target: the rect to highlight and the
-- 'PaneDrop' the drop performs. The highlight is found by simulating the
-- drop ('treeMovePane' with a throwaway split id) and laying the resulting
-- tree out ('layoutNode') into the grid rect, so it is exactly the region the
-- dragged pane will occupy after the drop, accounting for the restructuring
-- that removing the pane causes (its parent split collapses and sibling
-- subtrees expand) and for 'spacing' and min-size floors. Estimating the rect
-- from the target's pre-drop bounds goes wrong wherever mixed 'AxisV' /
-- 'AxisH' splits make those two layouts diverge. @spacing@ must be the gutter
-- actually laid out between panes: 'NanoUI.Widgets.PaneGrid' passes
-- @pgSpacing + 2 * pgLeeway@, not @pgSpacing@, or the preview regions drift
-- from the on-screen layout. 'Nothing' when the drop cannot be performed
-- (unknown pane ids, 'DropTop' on a single-pane grid).
dropPreview :: Float -> Float -> GridNode -> Word64 -> Rect -> PaneDrop -> Maybe (Rect, PaneDrop)
dropPreview :: Float
-> Float
-> GridNode
-> Word64
-> Rect
-> PaneDrop
-> Maybe (Rect, PaneDrop)
dropPreview Float
minSize Float
spacing GridNode
tree Word64
moved Rect
baseRect PaneDrop
dt = do
  t' <- Word64 -> Word64 -> PaneDrop -> GridNode -> Maybe GridNode
treeMovePane Word64
moved Word64
0 PaneDrop
dt GridNode
tree
  let (regions, _) = layoutNode minSize spacing t' baseRect
  r <- M.lookup moved regions
  pure (r, dt)