{-|
Module      : Monomer.Widgets.Containers.Split
Copyright   : (c) 2018 Francisco Vallarino
License     : BSD-3-Clause (see the LICENSE file)
Maintainer  : fjvallarino@gmail.com
Stability   : experimental
Portability : non-portable

Splits the assigned space into two areas, vertically or horizontally, which are
assigned to its two child nodes. The space assigned depends on the style and
size requirements of each child node.

@
actionPanel = vstack [
    button "Image 1" ShowImage1,
    button "Image 2" ShowImage2,
    button "Image 3" ShowImage3
  ]
contentPanel = scroll (image activeImage)

mainPanel = hsplit (actionPanel, contentPanel)
@
-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StrictData #-}

module Monomer.Widgets.Containers.Split (
  -- * Configuration
  SplitCfg,
  splitHandlePos,
  splitHandlePosV,
  splitHandleSize,
  splitIgnoreChildResize,
  -- * Constructors
  hsplit,
  hsplit_,
  vsplit,
  vsplit_
) where

import Control.Applicative ((<|>))
import Control.Lens (ALens', (&), (^.), (.~), (<>~))
import Data.Default
import Data.Maybe
import Data.Tuple (swap)
import GHC.Generics

import qualified Data.Sequence as Seq

import Monomer.Widgets.Container
import Monomer.Widgets.Containers.Stack (assignStackAreas)

import qualified Monomer.Lens as L

{-|
Configuration options for split:

- 'splitHandlePos': lens to a model field which provides the handle position.
- 'splitHandlePosV': value which provides the handle position.
- 'splitHandleSize': width of the handle.
- 'splitIgnoreChildResize': whether to ignore changes in size to its children
  (otherwise, the handle position may change because of this).
- 'onChange': raises an event when the handle is moved.
- 'onChangeReq': generates a WidgetReqest when the handle is moved.
-}
data SplitCfg s e = SplitCfg {
  forall s e. SplitCfg s e -> Maybe (WidgetData s Double)
_spcHandlePos :: Maybe (WidgetData s Double),
  forall s e. SplitCfg s e -> Maybe Double
_spcHandleSize :: Maybe Double,
  forall s e. SplitCfg s e -> Maybe Bool
_spcIgnoreChildResize :: Maybe Bool,
  forall s e. SplitCfg s e -> [Double -> WidgetRequest s e]
_spcOnChangeReq :: [Double -> WidgetRequest s e]
}

instance Default (SplitCfg s e) where
  def :: SplitCfg s e
def = SplitCfg {
    _spcHandlePos :: Maybe (WidgetData s Double)
_spcHandlePos = forall a. Maybe a
Nothing,
    _spcHandleSize :: Maybe Double
_spcHandleSize = forall a. Maybe a
Nothing,
    _spcIgnoreChildResize :: Maybe Bool
_spcIgnoreChildResize = forall a. Maybe a
Nothing,
    _spcOnChangeReq :: [Double -> WidgetRequest s e]
_spcOnChangeReq = []
  }

instance Semigroup (SplitCfg s e) where
  <> :: SplitCfg s e -> SplitCfg s e -> SplitCfg s e
(<>) SplitCfg s e
s1 SplitCfg s e
s2 = SplitCfg {
    _spcHandlePos :: Maybe (WidgetData s Double)
_spcHandlePos = forall s e. SplitCfg s e -> Maybe (WidgetData s Double)
_spcHandlePos SplitCfg s e
s2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. SplitCfg s e -> Maybe (WidgetData s Double)
_spcHandlePos SplitCfg s e
s1,
    _spcHandleSize :: Maybe Double
_spcHandleSize = forall s e. SplitCfg s e -> Maybe Double
_spcHandleSize SplitCfg s e
s2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. SplitCfg s e -> Maybe Double
_spcHandleSize SplitCfg s e
s1,
    _spcIgnoreChildResize :: Maybe Bool
_spcIgnoreChildResize = forall s e. SplitCfg s e -> Maybe Bool
_spcIgnoreChildResize SplitCfg s e
s2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. SplitCfg s e -> Maybe Bool
_spcIgnoreChildResize SplitCfg s e
s1,
    _spcOnChangeReq :: [Double -> WidgetRequest s e]
_spcOnChangeReq = forall s e. SplitCfg s e -> [Double -> WidgetRequest s e]
_spcOnChangeReq SplitCfg s e
s2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. SplitCfg s e -> [Double -> WidgetRequest s e]
_spcOnChangeReq SplitCfg s e
s1
  }

instance Monoid (SplitCfg s e) where
  mempty :: SplitCfg s e
mempty = forall a. Default a => a
def

instance WidgetEvent e => CmbOnChange (SplitCfg s e) Double e where
  onChange :: (Double -> e) -> SplitCfg s e
onChange Double -> e
fn = forall a. Default a => a
def {
    _spcOnChangeReq :: [Double -> WidgetRequest s e]
_spcOnChangeReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> e
fn]
  }

instance CmbOnChangeReq (SplitCfg s e) s e Double where
  onChangeReq :: (Double -> WidgetRequest s e) -> SplitCfg s e
onChangeReq Double -> WidgetRequest s e
req = forall a. Default a => a
def {
    _spcOnChangeReq :: [Double -> WidgetRequest s e]
_spcOnChangeReq = [Double -> WidgetRequest s e
req]
  }

-- | Lens to a model field which provides the handle position.
splitHandlePos :: ALens' s Double -> SplitCfg s e
splitHandlePos :: forall s e. ALens' s Double -> SplitCfg s e
splitHandlePos ALens' s Double
field = forall a. Default a => a
def {
  _spcHandlePos :: Maybe (WidgetData s Double)
_spcHandlePos = forall a. a -> Maybe a
Just (forall s a. ALens' s a -> WidgetData s a
WidgetLens ALens' s Double
field)
}

-- | Value which provides the handle position.
splitHandlePosV :: Double -> SplitCfg s e
splitHandlePosV :: forall s e. Double -> SplitCfg s e
splitHandlePosV Double
value = forall a. Default a => a
def {
  _spcHandlePos :: Maybe (WidgetData s Double)
_spcHandlePos = forall a. a -> Maybe a
Just (forall s a. a -> WidgetData s a
WidgetValue Double
value)
}

-- | Width of the handle.
splitHandleSize :: Double -> SplitCfg s e
splitHandleSize :: forall s e. Double -> SplitCfg s e
splitHandleSize Double
w = forall a. Default a => a
def {
  _spcHandleSize :: Maybe Double
_spcHandleSize = forall a. a -> Maybe a
Just Double
w
}

-- | Whether to ignore changes in size to its children.
splitIgnoreChildResize :: Bool -> SplitCfg s e
splitIgnoreChildResize :: forall s e. Bool -> SplitCfg s e
splitIgnoreChildResize Bool
ignore = forall a. Default a => a
def {
  _spcIgnoreChildResize :: Maybe Bool
_spcIgnoreChildResize = forall a. a -> Maybe a
Just Bool
ignore
}

data SplitState = SplitState {
  SplitState -> (SizeReq, SizeReq)
_spsPrevReqs :: (SizeReq, SizeReq),
  SplitState -> Double
_spsMaxSize :: Double,
  SplitState -> Bool
_spsHandlePosUserSet :: Bool,
  SplitState -> Double
_spsHandlePos :: Double,
  SplitState -> Rect
_spsHandleRect :: Rect
} deriving (SplitState -> SplitState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SplitState -> SplitState -> Bool
$c/= :: SplitState -> SplitState -> Bool
== :: SplitState -> SplitState -> Bool
$c== :: SplitState -> SplitState -> Bool
Eq, Int -> SplitState -> ShowS
[SplitState] -> ShowS
SplitState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SplitState] -> ShowS
$cshowList :: [SplitState] -> ShowS
show :: SplitState -> String
$cshow :: SplitState -> String
showsPrec :: Int -> SplitState -> ShowS
$cshowsPrec :: Int -> SplitState -> ShowS
Show, forall x. Rep SplitState x -> SplitState
forall x. SplitState -> Rep SplitState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SplitState x -> SplitState
$cfrom :: forall x. SplitState -> Rep SplitState x
Generic)

-- | Creates a horizontal split between the two provided nodes.
hsplit :: WidgetEvent e => (WidgetNode s e, WidgetNode s e) -> WidgetNode s e
hsplit :: forall e s.
WidgetEvent e =>
(WidgetNode s e, WidgetNode s e) -> WidgetNode s e
hsplit (WidgetNode s e, WidgetNode s e)
nodes = forall e s.
WidgetEvent e =>
[SplitCfg s e]
-> (WidgetNode s e, WidgetNode s e) -> WidgetNode s e
hsplit_ forall a. Default a => a
def (WidgetNode s e, WidgetNode s e)
nodes

-- | Creates a horizontal split between the two provided nodes. Accepts config.
hsplit_
  :: WidgetEvent e
  => [SplitCfg s e] -> (WidgetNode s e, WidgetNode s e) -> WidgetNode s e
hsplit_ :: forall e s.
WidgetEvent e =>
[SplitCfg s e]
-> (WidgetNode s e, WidgetNode s e) -> WidgetNode s e
hsplit_ [SplitCfg s e]
configs (WidgetNode s e, WidgetNode s e)
nodes = forall e s.
WidgetEvent e =>
Bool
-> (WidgetNode s e, WidgetNode s e)
-> [SplitCfg s e]
-> WidgetNode s e
split_ Bool
True (WidgetNode s e, WidgetNode s e)
nodes [SplitCfg s e]
configs

-- | Creates a vertical split between the two provided nodes.
vsplit :: WidgetEvent e => (WidgetNode s e, WidgetNode s e) -> WidgetNode s e
vsplit :: forall e s.
WidgetEvent e =>
(WidgetNode s e, WidgetNode s e) -> WidgetNode s e
vsplit (WidgetNode s e, WidgetNode s e)
nodes = forall e s.
WidgetEvent e =>
[SplitCfg s e]
-> (WidgetNode s e, WidgetNode s e) -> WidgetNode s e
vsplit_ forall a. Default a => a
def (WidgetNode s e, WidgetNode s e)
nodes

-- | Creates a vertical split between the two provided nodes. Accepts config.
vsplit_
  :: WidgetEvent e
  => [SplitCfg s e]
  -> (WidgetNode s e, WidgetNode s e)
  -> WidgetNode s e
vsplit_ :: forall e s.
WidgetEvent e =>
[SplitCfg s e]
-> (WidgetNode s e, WidgetNode s e) -> WidgetNode s e
vsplit_ [SplitCfg s e]
configs (WidgetNode s e, WidgetNode s e)
nodes = forall e s.
WidgetEvent e =>
Bool
-> (WidgetNode s e, WidgetNode s e)
-> [SplitCfg s e]
-> WidgetNode s e
split_ Bool
False (WidgetNode s e, WidgetNode s e)
nodes [SplitCfg s e]
configs

split_
  :: WidgetEvent e
  => Bool
  -> (WidgetNode s e, WidgetNode s e)
  -> [SplitCfg s e]
  -> WidgetNode s e
split_ :: forall e s.
WidgetEvent e =>
Bool
-> (WidgetNode s e, WidgetNode s e)
-> [SplitCfg s e]
-> WidgetNode s e
split_ Bool
isHorizontal (WidgetNode s e
node1, WidgetNode s e
node2) [SplitCfg s e]
configs = WidgetNode s e
newNode where
  config :: SplitCfg s e
config = forall a. Monoid a => [a] -> a
mconcat [SplitCfg s e]
configs
  state :: SplitState
state = SplitState {
    _spsPrevReqs :: (SizeReq, SizeReq)
_spsPrevReqs = forall a. Default a => a
def,
    _spsMaxSize :: Double
_spsMaxSize = Double
0,
    _spsHandlePosUserSet :: Bool
_spsHandlePosUserSet = Bool
False,
    _spsHandlePos :: Double
_spsHandlePos = Double
0.5,
    _spsHandleRect :: Rect
_spsHandleRect = forall a. Default a => a
def
  }
  widget :: Widget s e
widget = forall e s.
WidgetEvent e =>
Bool -> SplitCfg s e -> SplitState -> Widget s e
makeSplit Bool
isHorizontal SplitCfg s e
config SplitState
state
  widgetName :: WidgetType
widgetName = if Bool
isHorizontal then WidgetType
"hsplit" else WidgetType
"vsplit"
  newNode :: WidgetNode s e
newNode = forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
widgetName Widget s e
widget
    forall a b. a -> (a -> b) -> b
& forall s a. HasChildren s a => Lens' s a
L.children forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. [a] -> Seq a
Seq.fromList [WidgetNode s e
node1, WidgetNode s e
node2]

makeSplit :: WidgetEvent e => Bool -> SplitCfg s e -> SplitState -> Widget s e
makeSplit :: forall e s.
WidgetEvent e =>
Bool -> SplitCfg s e -> SplitState -> Widget s e
makeSplit Bool
isHorizontal SplitCfg s e
config SplitState
state = Widget s e
widget where
  widget :: Widget s e
widget = forall a s e. WidgetModel a => a -> Container s e a -> Widget s e
createContainer SplitState
state forall a. Default a => a
def {
    containerUseCustomCursor :: Bool
containerUseCustomCursor = Bool
True,
    containerLayoutDirection :: LayoutDirection
containerLayoutDirection = Bool -> LayoutDirection
getLayoutDirection Bool
isHorizontal,
    containerInit :: ContainerInitHandler s e
containerInit = ContainerInitHandler s e
init,
    containerMerge :: ContainerMergeHandler s e SplitState
containerMerge = forall {p}.
WidgetEnv s e
-> WidgetNode s e -> p -> SplitState -> WidgetResult s e
merge,
    containerHandleEvent :: ContainerEventHandler s e
containerHandleEvent = ContainerEventHandler s e
handleEvent,
    containerGetSizeReq :: ContainerGetSizeReqHandler s e
containerGetSizeReq = forall s e. ContainerGetSizeReqHandler s e
getSizeReq,
    containerResize :: ContainerResizeHandler s e
containerResize = ContainerResizeHandler s e
resize
  }

  handleW :: Double
handleW = forall a. a -> Maybe a -> a
fromMaybe Double
5 (forall s e. SplitCfg s e -> Maybe Double
_spcHandleSize SplitCfg s e
config)

  init :: ContainerInitHandler s e
init WidgetEnv s e
wenv WidgetNode s e
node = WidgetResult s e
result where
    useModelValue :: Double -> WidgetResult s e
useModelValue Double
value = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode where
      newState :: SplitState
newState = SplitState
state {
        _spsHandlePosUserSet :: Bool
_spsHandlePosUserSet = Bool
True,
        _spsHandlePos :: Double
_spsHandlePos = Double
value
      }
      newNode :: WidgetNode s e
newNode = WidgetNode s e
node
        forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall e s.
WidgetEvent e =>
Bool -> SplitCfg s e -> SplitState -> Widget s e
makeSplit Bool
isHorizontal SplitCfg s e
config SplitState
newState
    result :: WidgetResult s e
result = case forall s e. WidgetEnv s e -> SplitCfg s e -> Maybe Double
getModelPos WidgetEnv s e
wenv SplitCfg s e
config of
      Just Double
val
        | Double
val forall a. Ord a => a -> a -> Bool
>= Double
0 Bool -> Bool -> Bool
&& Double
val forall a. Ord a => a -> a -> Bool
<= Double
1 -> Double -> WidgetResult s e
useModelValue Double
val
      Maybe Double
_ -> forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node

  merge :: WidgetEnv s e
-> WidgetNode s e -> p -> SplitState -> WidgetResult s e
merge WidgetEnv s e
wenv WidgetNode s e
newNode p
oldNode SplitState
oldState = WidgetResult s e
result where
    oldHandlePos :: Double
oldHandlePos = SplitState -> Double
_spsHandlePos SplitState
oldState
    modelPos :: Maybe Double
modelPos = forall s e. WidgetEnv s e -> SplitCfg s e -> Maybe Double
getModelPos WidgetEnv s e
wenv SplitCfg s e
config
    newState :: SplitState
newState = SplitState
oldState {
      _spsHandlePos :: Double
_spsHandlePos = forall a. a -> Maybe a -> a
fromMaybe Double
oldHandlePos Maybe Double
modelPos
    }
    result :: WidgetResult s e
result = forall s e. WidgetNode s e -> WidgetResult s e
resultNode forall a b. (a -> b) -> a -> b
$ WidgetNode s e
newNode
      forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall e s.
WidgetEvent e =>
Bool -> SplitCfg s e -> SplitState -> Widget s e
makeSplit Bool
isHorizontal SplitCfg s e
config SplitState
newState

  handleEvent :: ContainerEventHandler s e
handleEvent WidgetEnv s e
wenv WidgetNode s e
node Path
target SystemEvent
evt = case SystemEvent
evt of
    Move Point
point
      | Bool
isTarget Bool -> Bool -> Bool
&& Bool
isDragging -> forall a. a -> Maybe a
Just WidgetResult s e
resultDrag
      | Point -> Bool
isInHandle Point
point Bool -> Bool -> Bool
&& CursorIcon
curIcon forall a. Eq a => a -> a -> Bool
/= CursorIcon
dragIcon -> forall a. a -> Maybe a
Just WidgetResult s e
resultHover
      | Bool -> Bool
not (Point -> Bool
isInHandle Point
point) Bool -> Bool -> Bool
&& Path
curPath forall a. Eq a => a -> a -> Bool
== Path
path -> forall a. a -> Maybe a
Just WidgetResult s e
resultReset
      where
        Point Double
px Double
py = Double -> Rect -> Point -> Seq (WidgetNode s e) -> Point
getValidHandlePos Double
maxSize Rect
vp Point
point Seq (WidgetNode s e)
children
        newHandlePos :: Double
newHandlePos
          | Bool
isHorizontal = (Double
px forall a. Num a => a -> a -> a
- Rect
vp forall s a. s -> Getting a s a -> a
^. forall s a. HasX s a => Lens' s a
L.x) forall a. Fractional a => a -> a -> a
/ Double
maxSize
          | Bool
otherwise = (Double
py forall a. Num a => a -> a -> a
- Rect
vp forall s a. s -> Getting a s a -> a
^. forall s a. HasY s a => Lens' s a
L.y) forall a. Fractional a => a -> a -> a
/ Double
maxSize
        newState :: SplitState
newState = SplitState
state {
          _spsHandlePosUserSet :: Bool
_spsHandlePosUserSet = Bool
True,
          _spsHandlePos :: Double
_spsHandlePos = Double
newHandlePos
        }

        resizeReq :: b -> Bool
resizeReq = forall a b. a -> b -> a
const Bool
True
        tmpNode :: WidgetNode s e
tmpNode = WidgetNode s e
node
          forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall e s.
WidgetEvent e =>
Bool -> SplitCfg s e -> SplitState -> Widget s e
makeSplit Bool
isHorizontal SplitCfg s e
config SplitState
newState
        newNode :: WidgetResult s e
newNode = forall s e.
Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> Rect
-> (Path -> Bool)
-> WidgetResult s e
widgetResize (WidgetNode s e
tmpNode forall s a. s -> Getting a s a -> a
^. forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s e
wenv WidgetNode s e
tmpNode Rect
vp forall {b}. b -> Bool
resizeReq

        resultDrag :: WidgetResult s e
resultDrag
          | Double
handlePos forall a. Eq a => a -> a -> Bool
/= Double
newHandlePos = WidgetResult s e
newNode
              forall a b. a -> (a -> b) -> b
& forall s a. HasRequests s a => Lens' s a
L.requests forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ forall a. [a] -> Seq a
Seq.fromList [forall {s} {e}. WidgetRequest s e
cursorIconReq, forall {s} {e}. WidgetRequest s e
RenderOnce]
          | Bool
otherwise = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [forall {s} {e}. WidgetRequest s e
cursorIconReq]

        resultHover :: WidgetResult s e
resultHover = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [forall {s} {e}. WidgetRequest s e
cursorIconReq]
        resultReset :: WidgetResult s e
resultReset = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [forall s e. WidgetId -> WidgetRequest s e
ResetCursorIcon WidgetId
widgetId]
    SystemEvent
_ -> forall a. Maybe a
Nothing
    where
      maxSize :: Double
maxSize = SplitState -> Double
_spsMaxSize SplitState
state
      handlePos :: Double
handlePos = SplitState -> Double
_spsHandlePos SplitState
state
      handleRect :: Rect
handleRect = SplitState -> Rect
_spsHandleRect SplitState
state

      widgetId :: WidgetId
widgetId = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId
      path :: Path
path = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasPath s a => Lens' s a
L.path
      vp :: Rect
vp = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasViewport s a => Lens' s a
L.viewport
      children :: Seq (WidgetNode s e)
children = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasChildren s a => Lens' s a
L.children

      isTarget :: Bool
isTarget = Path
target forall a. Eq a => a -> a -> Bool
== WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasPath s a => Lens' s a
L.path
      (Path
curPath, CursorIcon
curIcon) = forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def (WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasCursor s a => Lens' s a
L.cursor)
      isDragging :: Bool
isDragging = forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodePressed WidgetEnv s e
wenv WidgetNode s e
node
      isInHandle :: Point -> Bool
isInHandle Point
p = Point -> Rect -> Bool
pointInRect Point
p Rect
handleRect
      dragIcon :: CursorIcon
dragIcon
        | Bool
isHorizontal = CursorIcon
CursorSizeH
        | Bool
otherwise = CursorIcon
CursorSizeV
      cursorIconReq :: WidgetRequest s e
cursorIconReq = forall s e. WidgetId -> CursorIcon -> WidgetRequest s e
SetCursorIcon WidgetId
widgetId CursorIcon
dragIcon

  getSizeReq :: ContainerGetSizeReqHandler s e
  getSizeReq :: forall s e. ContainerGetSizeReqHandler s e
getSizeReq WidgetEnv s e
wenv WidgetNode s e
node Seq (WidgetNode s e)
children = (SizeReq
reqW, SizeReq
reqH) where
    node1 :: WidgetNode s e
node1 = forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
0
    node2 :: WidgetNode s e
node2 = forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
1

    reqW1 :: SizeReq
reqW1 = WidgetNode s e
node1 forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW
    reqH1 :: SizeReq
reqH1 = WidgetNode s e
node1 forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH
    reqW2 :: SizeReq
reqW2 = WidgetNode s e
node2 forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW
    reqH2 :: SizeReq
reqH2 = WidgetNode s e
node2 forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH

    reqWS :: SizeReq
reqWS = Double -> SizeReq
fixedSize Double
handleW
    reqW :: SizeReq
reqW
      | Bool
isHorizontal = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 SizeReq -> SizeReq -> SizeReq
sizeReqMergeSum [SizeReq
reqWS, SizeReq
reqW1, SizeReq
reqW2]
      | Bool
otherwise = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 SizeReq -> SizeReq -> SizeReq
sizeReqMergeMax [SizeReq
reqW1, SizeReq
reqW2]
    reqH :: SizeReq
reqH
      | Bool
isHorizontal = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 SizeReq -> SizeReq -> SizeReq
sizeReqMergeMax [SizeReq
reqH1, SizeReq
reqH2]
      | Bool
otherwise = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 SizeReq -> SizeReq -> SizeReq
sizeReqMergeSum [SizeReq
reqWS, SizeReq
reqH1, SizeReq
reqH2]

  resize :: ContainerResizeHandler s e
resize WidgetEnv s e
wenv WidgetNode s e
node Rect
viewport Seq (WidgetNode s e)
children = (WidgetResult s e, Seq Rect)
resized where
    style :: StyleState
style = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
    contentArea :: Rect
contentArea = forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def (StyleState -> Rect -> Maybe Rect
removeOuterBounds StyleState
style Rect
viewport)
    Rect Double
rx Double
ry Double
rw Double
rh = Rect
contentArea
    (Seq Rect
areas, Double
newSize) = forall s e.
Bool
-> Rect -> Double -> Seq (WidgetNode s e) -> (Seq Rect, Double)
assignStackAreas Bool
isHorizontal Rect
contentArea Double
0 Seq (WidgetNode s e)
children
    oldHandlePos :: Double
oldHandlePos = SplitState -> Double
_spsHandlePos SplitState
state

    sizeReq1 :: SizeReq
sizeReq1 = WidgetNode s e -> SizeReq
sizeReq forall a b. (a -> b) -> a -> b
$ forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
0
    sizeReq2 :: SizeReq
sizeReq2 = WidgetNode s e -> SizeReq
sizeReq forall a b. (a -> b) -> a -> b
$ forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
1
    valid1 :: Bool
valid1 = SizeReq -> Double -> Double -> Bool
sizeReqValid SizeReq
sizeReq1 Double
0 (Double
newSize forall a. Num a => a -> a -> a
* Double
oldHandlePos)
    valid2 :: Bool
valid2 = SizeReq -> Double -> Double -> Bool
sizeReqValid SizeReq
sizeReq2 Double
0 (Double
newSize forall a. Num a => a -> a -> a
* (Double
1 forall a. Num a => a -> a -> a
- Double
oldHandlePos))
    validSize :: Bool
validSize = Bool
valid1 Bool -> Bool -> Bool
&& Bool
valid2

    handlePosUserSet :: Bool
handlePosUserSet = SplitState -> Bool
_spsHandlePosUserSet SplitState
state
    ignoreSizeReq :: Bool
ignoreSizeReq = forall a. a -> Maybe a
Just Bool
True forall a. Eq a => a -> a -> Bool
== forall s e. SplitCfg s e -> Maybe Bool
_spcIgnoreChildResize SplitCfg s e
config
    sizeReqEquals :: Bool
sizeReqEquals = (SizeReq
sizeReq1, SizeReq
sizeReq2) forall a. Eq a => a -> a -> Bool
== SplitState -> (SizeReq, SizeReq)
_spsPrevReqs SplitState
state
    resizeNeeded :: Bool
resizeNeeded = Bool -> Bool
not (Bool
sizeReqEquals Bool -> Bool -> Bool
&& Bool
handlePosUserSet)

    customPos :: Bool
customPos = forall a. Maybe a -> Bool
isJust (forall s e. SplitCfg s e -> Maybe (WidgetData s Double)
_spcHandlePos SplitCfg s e
config)
    useOldPos :: Bool
useOldPos = Bool
customPos Bool -> Bool -> Bool
|| Bool
ignoreSizeReq Bool -> Bool -> Bool
|| Bool
sizeReqEquals
    initialPos :: Double
initialPos = Seq (WidgetNode s e) -> Double
initialHandlePos Seq (WidgetNode s e)
children

    handlePos :: Double
handlePos
      | Bool
useOldPos Bool -> Bool -> Bool
&& Bool
handlePosUserSet Bool -> Bool -> Bool
&& Bool
validSize = Double
oldHandlePos
      | Bool
resizeNeeded = Double -> Double -> Rect -> Seq (WidgetNode s e) -> Double
calcHandlePos Double
newSize Double
initialPos Rect
viewport Seq (WidgetNode s e)
children
      | Bool
otherwise = Double -> Double -> Rect -> Seq (WidgetNode s e) -> Double
calcHandlePos Double
newSize Double
oldHandlePos Rect
viewport Seq (WidgetNode s e)
children
    (Double
w1, Double
h1)
      | Bool
isHorizontal = ((Double
newSize forall a. Num a => a -> a -> a
- Double
handleW) forall a. Num a => a -> a -> a
* Double
handlePos, Double
rh)
      | Bool
otherwise = (Double
rw, (Double
newSize forall a. Num a => a -> a -> a
- Double
handleW) forall a. Num a => a -> a -> a
* Double
handlePos)
    (Double
w2, Double
h2)
      | Bool
isHorizontal = (Double
newSize forall a. Num a => a -> a -> a
- Double
w1 forall a. Num a => a -> a -> a
- Double
handleW, Double
rh)
      | Bool
otherwise = (Double
rw, Double
newSize forall a. Num a => a -> a -> a
- Double
h1 forall a. Num a => a -> a -> a
- Double
handleW)

    rect1 :: Rect
rect1 = Double -> Double -> Double -> Double -> Rect
Rect Double
rx Double
ry Double
w1 Double
h1
    rect2 :: Rect
rect2
      | Bool
isHorizontal = Double -> Double -> Double -> Double -> Rect
Rect (Double
rx forall a. Num a => a -> a -> a
+ Double
w1 forall a. Num a => a -> a -> a
+ Double
handleW) Double
ry Double
w2 Double
h2
      | Bool
otherwise = Double -> Double -> Double -> Double -> Rect
Rect Double
rx (Double
ry forall a. Num a => a -> a -> a
+ Double
h1 forall a. Num a => a -> a -> a
+ Double
handleW) Double
w2 Double
h2
    newHandleRect :: Rect
newHandleRect
      | Bool
isHorizontal = Double -> Double -> Double -> Double -> Rect
Rect (Double
rx forall a. Num a => a -> a -> a
+ Double
w1) Double
ry Double
handleW Double
h1
      | Bool
otherwise = Double -> Double -> Double -> Double -> Rect
Rect Double
rx (Double
ry forall a. Num a => a -> a -> a
+ Double
h1) Double
w1 Double
handleW

    newState :: SplitState
newState = SplitState
state {
      _spsHandlePos :: Double
_spsHandlePos = Double
handlePos,
      _spsHandleRect :: Rect
_spsHandleRect = Rect
newHandleRect,
      _spsMaxSize :: Double
_spsMaxSize = Double
newSize,
      _spsPrevReqs :: (SizeReq, SizeReq)
_spsPrevReqs = (SizeReq
sizeReq1, SizeReq
sizeReq2)
    }

    reqOnChange :: [WidgetRequest s e]
reqOnChange = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ Double
handlePos) (forall s e. SplitCfg s e -> [Double -> WidgetRequest s e]
_spcOnChangeReq SplitCfg s e
config)
    requestPos :: [WidgetRequest s e]
requestPos = forall s e. SplitCfg s e -> Double -> [WidgetRequest s e]
setModelPos SplitCfg s e
config Double
handlePos
    result :: WidgetResult s e
result = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node
      forall a b. a -> (a -> b) -> b
& forall s a. HasNode s a => Lens' s a
L.node forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall e s.
WidgetEvent e =>
Bool -> SplitCfg s e -> SplitState -> Widget s e
makeSplit Bool
isHorizontal SplitCfg s e
config SplitState
newState
      forall a b. a -> (a -> b) -> b
& forall s a. HasRequests s a => Lens' s a
L.requests forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. [a] -> Seq a
Seq.fromList ([WidgetRequest s e]
requestPos forall a. [a] -> [a] -> [a]
++ [WidgetRequest s e]
reqOnChange)
    newVps :: Seq Rect
newVps = forall a. [a] -> Seq a
Seq.fromList [Rect
rect1, Rect
rect2]
    resized :: (WidgetResult s e, Seq Rect)
resized
      | WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasVisible s a => Lens' s a
L.visible = (WidgetResult s e
result, Seq Rect
newVps)
      | Bool
otherwise = (forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node, Seq Rect
newVps)

  getValidHandlePos :: Double -> Rect -> Point -> Seq (WidgetNode s e) -> Point
getValidHandlePos Double
maxDim Rect
vp Point
handleXY Seq (WidgetNode s e)
children = Point -> Point -> Point
addPoint Point
origin Point
newPoint where
    Rect Double
rx Double
ry Double
_ Double
_ = Rect
vp
    Point Double
vx Double
vy = Rect -> Point -> Point
rectBoundedPoint Rect
vp Point
handleXY

    origin :: Point
origin = Double -> Double -> Point
Point Double
rx Double
ry
    isVertical :: Bool
isVertical = Bool -> Bool
not Bool
isHorizontal
    child1 :: WidgetNode s e
child1 = forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
0
    child2 :: WidgetNode s e
child2 = forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
1

    minSize1 :: Double
minSize1 = SizeReq -> Double
sizeReqMin (WidgetNode s e -> SizeReq
sizeReq WidgetNode s e
child1)
    maxSize1 :: Double
maxSize1 = SizeReq -> Double
sizeReqMax (WidgetNode s e -> SizeReq
sizeReq WidgetNode s e
child1)
    minSize2 :: Double
minSize2 = SizeReq -> Double
sizeReqMin (WidgetNode s e -> SizeReq
sizeReq WidgetNode s e
child2)
    maxSize2 :: Double
maxSize2 = SizeReq -> Double
sizeReqMax (WidgetNode s e -> SizeReq
sizeReq WidgetNode s e
child2)

    (Double
tw, Double
th)
      | Bool
isHorizontal = (forall a. Ord a => a -> a -> a
max Double
minSize1 (forall a. Ord a => a -> a -> a
min Double
maxSize1 forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
abs (Double
vx forall a. Num a => a -> a -> a
- Double
rx)), Double
0)
      | Bool
otherwise = (Double
0, forall a. Ord a => a -> a -> a
max Double
minSize1 (forall a. Ord a => a -> a -> a
min Double
maxSize1 forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
abs (Double
vy forall a. Num a => a -> a -> a
- Double
ry)))
    newPoint :: Point
newPoint
      | Bool
isHorizontal Bool -> Bool -> Bool
&& Double
tw forall a. Num a => a -> a -> a
+ Double
minSize2 forall a. Ord a => a -> a -> Bool
> Double
maxDim = Double -> Double -> Point
Point (Double
maxDim forall a. Num a => a -> a -> a
- Double
minSize2) Double
th
      | Bool
isHorizontal Bool -> Bool -> Bool
&& Double
maxDim forall a. Num a => a -> a -> a
- Double
tw forall a. Ord a => a -> a -> Bool
> Double
maxSize2 = Double -> Double -> Point
Point (Double
maxDim forall a. Num a => a -> a -> a
- Double
maxSize2) Double
th
      | Bool
isVertical Bool -> Bool -> Bool
&& Double
th forall a. Num a => a -> a -> a
+ Double
minSize2 forall a. Ord a => a -> a -> Bool
> Double
maxDim = Double -> Double -> Point
Point Double
tw (Double
maxDim forall a. Num a => a -> a -> a
- Double
minSize2)
      | Bool
isVertical Bool -> Bool -> Bool
&& Double
maxDim forall a. Num a => a -> a -> a
- Double
th forall a. Ord a => a -> a -> Bool
> Double
maxSize2 = Double -> Double -> Point
Point Double
tw (Double
maxDim forall a. Num a => a -> a -> a
- Double
maxSize2)
      | Bool
otherwise = Double -> Double -> Point
Point Double
tw Double
th

  calcHandlePos :: Double -> Double -> Rect -> Seq (WidgetNode s e) -> Double
calcHandlePos Double
maxDim Double
handlePos Rect
vp Seq (WidgetNode s e)
children = Double
newPos where
    Rect Double
rx Double
ry Double
_ Double
_ = Rect
vp
    handleXY :: Point
handleXY
      | Bool
isHorizontal = Double -> Double -> Point
Point (Double
rx forall a. Num a => a -> a -> a
+ Double
maxDim forall a. Num a => a -> a -> a
* Double
handlePos) Double
0
      | Bool
otherwise = Double -> Double -> Point
Point Double
0 (Double
ry forall a. Num a => a -> a -> a
+ Double
maxDim forall a. Num a => a -> a -> a
* Double
handlePos)
    Point Double
px Double
py = Double -> Rect -> Point -> Seq (WidgetNode s e) -> Point
getValidHandlePos Double
maxDim Rect
vp Point
handleXY Seq (WidgetNode s e)
children
    newPos :: Double
newPos
      | Bool
isHorizontal = (Double
px forall a. Num a => a -> a -> a
- Double
rx) forall a. Fractional a => a -> a -> a
/ Double
maxDim
      | Bool
otherwise = (Double
py forall a. Num a => a -> a -> a
- Double
ry) forall a. Fractional a => a -> a -> a
/ Double
maxDim

  initialHandlePos :: Seq (WidgetNode s e) -> Double
initialHandlePos Seq (WidgetNode s e)
children = Double
handlePos where
    child1 :: WidgetNode s e
child1 = forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
0
    child2 :: WidgetNode s e
child2 = forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
1
    maxSize1 :: Double
maxSize1 = SizeReq -> Double
sizeReqMaxBounded (WidgetNode s e -> SizeReq
sizeReq WidgetNode s e
child1)
    maxSize2 :: Double
maxSize2 = SizeReq -> Double
sizeReqMaxBounded (WidgetNode s e -> SizeReq
sizeReq WidgetNode s e
child2)
    handlePos :: Double
handlePos = Double
maxSize1 forall a. Fractional a => a -> a -> a
/ (Double
maxSize1 forall a. Num a => a -> a -> a
+ Double
maxSize2)

  selector :: Rect -> Double
selector
    | Bool
isHorizontal = Rect -> Double
_rW
    | Bool
otherwise = Rect -> Double
_rH

  sizeReq :: WidgetNode s e -> SizeReq
sizeReq
    | Bool
isHorizontal = (forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW)
    | Bool
otherwise = (forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH)

setModelPos :: SplitCfg s e -> Double -> [WidgetRequest s e]
setModelPos :: forall s e. SplitCfg s e -> Double -> [WidgetRequest s e]
setModelPos SplitCfg s e
cfg
  | forall a. Maybe a -> Bool
isJust (forall s e. SplitCfg s e -> Maybe (WidgetData s Double)
_spcHandlePos SplitCfg s e
cfg) = forall s a e. WidgetData s a -> a -> [WidgetRequest s e]
widgetDataSet (forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall s e. SplitCfg s e -> Maybe (WidgetData s Double)
_spcHandlePos SplitCfg s e
cfg)
  | Bool
otherwise = forall a b. a -> b -> a
const []

getModelPos :: WidgetEnv s e -> SplitCfg s e -> Maybe Double
getModelPos :: forall s e. WidgetEnv s e -> SplitCfg s e -> Maybe Double
getModelPos WidgetEnv s e
wenv SplitCfg s e
cfg
  | forall a. Maybe a -> Bool
isJust Maybe (WidgetData s Double)
handlePosL = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall s a. s -> WidgetData s a -> a
widgetDataGet s
model (forall a. HasCallStack => Maybe a -> a
fromJust Maybe (WidgetData s Double)
handlePosL)
  | Bool
otherwise = forall a. Maybe a
Nothing
  where
    model :: s
model = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasModel s a => Lens' s a
L.model
    handlePosL :: Maybe (WidgetData s Double)
handlePosL = forall s e. SplitCfg s e -> Maybe (WidgetData s Double)
_spcHandlePos SplitCfg s e
cfg