{-|
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 {
  SplitCfg s e -> Maybe (WidgetData s Double)
_spcHandlePos :: Maybe (WidgetData s Double),
  SplitCfg s e -> Maybe Double
_spcHandleSize :: Maybe Double,
  SplitCfg s e -> Maybe Bool
_spcIgnoreChildResize :: Maybe Bool,
  SplitCfg s e -> [Double -> WidgetRequest s e]
_spcOnChangeReq :: [Double -> WidgetRequest s e]
}

instance Default (SplitCfg s e) where
  def :: SplitCfg s e
def = SplitCfg :: forall s e.
Maybe (WidgetData s Double)
-> Maybe Double
-> Maybe Bool
-> [Double -> WidgetRequest s e]
-> SplitCfg s e
SplitCfg {
    _spcHandlePos :: Maybe (WidgetData s Double)
_spcHandlePos = Maybe (WidgetData s Double)
forall a. Maybe a
Nothing,
    _spcHandleSize :: Maybe Double
_spcHandleSize = Maybe Double
forall a. Maybe a
Nothing,
    _spcIgnoreChildResize :: Maybe Bool
_spcIgnoreChildResize = Maybe Bool
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 :: forall s e.
Maybe (WidgetData s Double)
-> Maybe Double
-> Maybe Bool
-> [Double -> WidgetRequest s e]
-> SplitCfg s e
SplitCfg {
    _spcHandlePos :: Maybe (WidgetData s Double)
_spcHandlePos = SplitCfg s e -> Maybe (WidgetData s Double)
forall s e. SplitCfg s e -> Maybe (WidgetData s Double)
_spcHandlePos SplitCfg s e
s2 Maybe (WidgetData s Double)
-> Maybe (WidgetData s Double) -> Maybe (WidgetData s Double)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SplitCfg s e -> Maybe (WidgetData s Double)
forall s e. SplitCfg s e -> Maybe (WidgetData s Double)
_spcHandlePos SplitCfg s e
s1,
    _spcHandleSize :: Maybe Double
_spcHandleSize = SplitCfg s e -> Maybe Double
forall s e. SplitCfg s e -> Maybe Double
_spcHandleSize SplitCfg s e
s2 Maybe Double -> Maybe Double -> Maybe Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SplitCfg s e -> Maybe Double
forall s e. SplitCfg s e -> Maybe Double
_spcHandleSize SplitCfg s e
s1,
    _spcIgnoreChildResize :: Maybe Bool
_spcIgnoreChildResize = SplitCfg s e -> Maybe Bool
forall s e. SplitCfg s e -> Maybe Bool
_spcIgnoreChildResize SplitCfg s e
s2 Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SplitCfg s e -> Maybe Bool
forall s e. SplitCfg s e -> Maybe Bool
_spcIgnoreChildResize SplitCfg s e
s1,
    _spcOnChangeReq :: [Double -> WidgetRequest s e]
_spcOnChangeReq = SplitCfg s e -> [Double -> WidgetRequest s e]
forall s e. SplitCfg s e -> [Double -> WidgetRequest s e]
_spcOnChangeReq SplitCfg s e
s2 [Double -> WidgetRequest s e]
-> [Double -> WidgetRequest s e] -> [Double -> WidgetRequest s e]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SplitCfg s e -> [Double -> WidgetRequest s e]
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 = SplitCfg s e
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 = SplitCfg s Any
forall a. Default a => a
def {
    _spcOnChangeReq :: [Double -> WidgetRequest s e]
_spcOnChangeReq = [e -> WidgetRequest s e
forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent (e -> WidgetRequest s e)
-> (Double -> e) -> Double -> WidgetRequest s e
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 = SplitCfg s Any
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 :: ALens' s Double -> SplitCfg s e
splitHandlePos ALens' s Double
field = SplitCfg s e
forall a. Default a => a
def {
  _spcHandlePos :: Maybe (WidgetData s Double)
_spcHandlePos = WidgetData s Double -> Maybe (WidgetData s Double)
forall a. a -> Maybe a
Just (ALens' s Double -> WidgetData s Double
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 :: Double -> SplitCfg s e
splitHandlePosV Double
value = SplitCfg s e
forall a. Default a => a
def {
  _spcHandlePos :: Maybe (WidgetData s Double)
_spcHandlePos = WidgetData s Double -> Maybe (WidgetData s Double)
forall a. a -> Maybe a
Just (Double -> WidgetData s Double
forall s a. a -> WidgetData s a
WidgetValue Double
value)
}

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

-- | Whether to ignore changes in size to its children.
splitIgnoreChildResize :: Bool -> SplitCfg s e
splitIgnoreChildResize :: Bool -> SplitCfg s e
splitIgnoreChildResize Bool
ignore = SplitCfg s e
forall a. Default a => a
def {
  _spcIgnoreChildResize :: Maybe Bool
_spcIgnoreChildResize = Bool -> Maybe Bool
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
(SplitState -> SplitState -> Bool)
-> (SplitState -> SplitState -> Bool) -> Eq SplitState
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
(Int -> SplitState -> ShowS)
-> (SplitState -> String)
-> ([SplitState] -> ShowS)
-> Show SplitState
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. SplitState -> Rep SplitState x)
-> (forall x. Rep SplitState x -> SplitState) -> Generic SplitState
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 :: (WidgetNode s e, WidgetNode s e) -> WidgetNode s e
hsplit (WidgetNode s e, WidgetNode s e)
nodes = [SplitCfg s e]
-> (WidgetNode s e, WidgetNode s e) -> WidgetNode s e
forall e s.
WidgetEvent e =>
[SplitCfg s e]
-> (WidgetNode s e, WidgetNode s e) -> WidgetNode s e
hsplit_ [SplitCfg s e]
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_ :: [SplitCfg s e]
-> (WidgetNode s e, WidgetNode s e) -> WidgetNode s e
hsplit_ [SplitCfg s e]
configs (WidgetNode s e, WidgetNode s e)
nodes = Bool
-> (WidgetNode s e, WidgetNode s e)
-> [SplitCfg s e]
-> WidgetNode s e
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 :: (WidgetNode s e, WidgetNode s e) -> WidgetNode s e
vsplit (WidgetNode s e, WidgetNode s e)
nodes = [SplitCfg s e]
-> (WidgetNode s e, WidgetNode s e) -> WidgetNode s e
forall e s.
WidgetEvent e =>
[SplitCfg s e]
-> (WidgetNode s e, WidgetNode s e) -> WidgetNode s e
vsplit_ [SplitCfg s e]
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_ :: [SplitCfg s e]
-> (WidgetNode s e, WidgetNode s e) -> WidgetNode s e
vsplit_ [SplitCfg s e]
configs (WidgetNode s e, WidgetNode s e)
nodes = Bool
-> (WidgetNode s e, WidgetNode s e)
-> [SplitCfg s e]
-> WidgetNode s e
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_ :: 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 = [SplitCfg s e] -> SplitCfg s e
forall a. Monoid a => [a] -> a
mconcat [SplitCfg s e]
configs
  state :: SplitState
state = SplitState :: (SizeReq, SizeReq)
-> Double -> Bool -> Double -> Rect -> SplitState
SplitState {
    _spsPrevReqs :: (SizeReq, SizeReq)
_spsPrevReqs = (SizeReq, SizeReq)
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 = Rect
forall a. Default a => a
def
  }
  widget :: Widget s e
widget = Bool -> SplitCfg s e -> SplitState -> Widget s e
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 = WidgetType -> Widget s e -> WidgetNode s e
forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
widgetName Widget s e
widget
    WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasChildren s a => Lens' s a
L.children ((Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Seq (WidgetNode s e) -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [WidgetNode s e] -> Seq (WidgetNode s e)
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 :: 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 = SplitState -> Container s e SplitState -> Widget s e
forall a s e. WidgetModel a => a -> Container s e a -> Widget s e
createContainer SplitState
state Container s e SplitState
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 = ContainerMergeHandler s e SplitState
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 = ContainerGetSizeReqHandler s e
forall s e. ContainerGetSizeReqHandler s e
getSizeReq,
    containerResize :: ContainerResizeHandler s e
containerResize = ContainerResizeHandler s e
resize
  }

  handleW :: Double
handleW = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
5 (SplitCfg s e -> Maybe Double
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 = WidgetNode s e -> WidgetResult s e
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
        WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool -> SplitCfg s e -> SplitState -> Widget s e
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 WidgetEnv s e -> SplitCfg s e -> Maybe Double
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 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0 Bool -> Bool -> Bool
&& Double
val Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
1 -> Double -> WidgetResult s e
useModelValue Double
val
      Maybe Double
_ -> WidgetNode s e -> WidgetResult s e
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 = WidgetEnv s e -> SplitCfg s e -> Maybe Double
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 = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
oldHandlePos Maybe Double
modelPos
    }
    result :: WidgetResult s e
result = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode (WidgetNode s e -> WidgetResult s e)
-> WidgetNode s e -> WidgetResult s e
forall a b. (a -> b) -> a -> b
$ WidgetNode s e
newNode
      WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool -> SplitCfg s e -> SplitState -> Widget s e
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 -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
resultDrag
      | Point -> Bool
isInHandle Point
point Bool -> Bool -> Bool
&& CursorIcon
curIcon CursorIcon -> CursorIcon -> Bool
forall a. Eq a => a -> a -> Bool
/= CursorIcon
dragIcon -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
resultHover
      | Bool -> Bool
not (Point -> Bool
isInHandle Point
point) Bool -> Bool -> Bool
&& Path
curPath Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== Path
path -> WidgetResult s e -> Maybe (WidgetResult s e)
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 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Rect
vp Rect -> Getting Double Rect Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double Rect Double
forall s a. HasX s a => Lens' s a
L.x) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
maxSize
          | Bool
otherwise = (Double
py Double -> Double -> Double
forall a. Num a => a -> a -> a
- Rect
vp Rect -> Getting Double Rect Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double Rect Double
forall s a. HasY s a => Lens' s a
L.y) Double -> Double -> Double
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 = Bool -> b -> Bool
forall a b. a -> b -> a
const Bool
True
        tmpNode :: WidgetNode s e
tmpNode = WidgetNode s e
node
          WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool -> SplitCfg s e -> SplitState -> Widget s e
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 = Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> Rect
-> (Path -> Bool)
-> WidgetResult s e
forall s e.
Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> Rect
-> (Path -> Bool)
-> WidgetResult s e
widgetResize (WidgetNode s e
tmpNode WidgetNode s e
-> Getting (Widget s e) (WidgetNode s e) (Widget s e) -> Widget s e
forall s a. s -> Getting a s a -> a
^. Getting (Widget s e) (WidgetNode s e) (Widget s e)
forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s e
wenv WidgetNode s e
tmpNode Rect
vp Path -> Bool
forall b. b -> Bool
resizeReq

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

        resultHover :: WidgetResult s e
resultHover = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e
forall s e. WidgetRequest s e
cursorIconReq]
        resultReset :: WidgetResult s e
resultReset = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
ResetCursorIcon WidgetId
widgetId]
    SystemEvent
_ -> Maybe (WidgetResult s e)
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 WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
 -> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((WidgetId -> Const WidgetId WidgetId)
    -> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
L.widgetId
      path :: Path
path = WidgetNode s e
node WidgetNode s e -> Getting Path (WidgetNode s e) Path -> Path
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> WidgetNode s e -> Const Path (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Path WidgetNodeInfo)
 -> WidgetNode s e -> Const Path (WidgetNode s e))
-> ((Path -> Const Path Path)
    -> WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> Getting Path (WidgetNode s e) Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const Path Path)
-> WidgetNodeInfo -> Const Path WidgetNodeInfo
forall s a. HasPath s a => Lens' s a
L.path
      vp :: Rect
vp = WidgetNode s e
node WidgetNode s e -> Getting Rect (WidgetNode s e) Rect -> Rect
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> WidgetNode s e -> Const Rect (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Rect WidgetNodeInfo)
 -> WidgetNode s e -> Const Rect (WidgetNode s e))
-> ((Rect -> Const Rect Rect)
    -> WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> Getting Rect (WidgetNode s e) Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Const Rect Rect)
-> WidgetNodeInfo -> Const Rect WidgetNodeInfo
forall s a. HasViewport s a => Lens' s a
L.viewport
      children :: Seq (WidgetNode s e)
children = WidgetNode s e
node WidgetNode s e
-> Getting
     (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
  (Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children

      isTarget :: Bool
isTarget = Path
target Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== WidgetNode s e
node WidgetNode s e -> Getting Path (WidgetNode s e) Path -> Path
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> WidgetNode s e -> Const Path (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Path WidgetNodeInfo)
 -> WidgetNode s e -> Const Path (WidgetNode s e))
-> ((Path -> Const Path Path)
    -> WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> Getting Path (WidgetNode s e) Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const Path Path)
-> WidgetNodeInfo -> Const Path WidgetNodeInfo
forall s a. HasPath s a => Lens' s a
L.path
      (Path
curPath, CursorIcon
curIcon) = (Path, CursorIcon)
-> Maybe (Path, CursorIcon) -> (Path, CursorIcon)
forall a. a -> Maybe a -> a
fromMaybe (Path, CursorIcon)
forall a. Default a => a
def (WidgetEnv s e
wenv WidgetEnv s e
-> Getting
     (Maybe (Path, CursorIcon))
     (WidgetEnv s e)
     (Maybe (Path, CursorIcon))
-> Maybe (Path, CursorIcon)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Path, CursorIcon))
  (WidgetEnv s e)
  (Maybe (Path, CursorIcon))
forall s a. HasCursor s a => Lens' s a
L.cursor)
      isDragging :: Bool
isDragging = WidgetEnv s e -> WidgetNode s e -> Bool
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 = WidgetId -> CursorIcon -> WidgetRequest s e
forall s e. WidgetId -> CursorIcon -> WidgetRequest s e
SetCursorIcon WidgetId
widgetId CursorIcon
dragIcon

  getSizeReq :: ContainerGetSizeReqHandler s e
  getSizeReq :: 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 = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
0
    node2 :: WidgetNode s e
node2 = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
1

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

    reqWS :: SizeReq
reqWS = Double -> SizeReq
fixedSize Double
handleW
    reqW :: SizeReq
reqW
      | Bool
isHorizontal = (SizeReq -> SizeReq -> SizeReq) -> [SizeReq] -> SizeReq
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 SizeReq -> SizeReq -> SizeReq
sizeReqMergeSum [SizeReq
reqWS, SizeReq
reqW1, SizeReq
reqW2]
      | Bool
otherwise = (SizeReq -> SizeReq -> SizeReq) -> [SizeReq] -> SizeReq
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 = (SizeReq -> SizeReq -> SizeReq) -> [SizeReq] -> SizeReq
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 SizeReq -> SizeReq -> SizeReq
sizeReqMergeMax [SizeReq
reqH1, SizeReq
reqH2]
      | Bool
otherwise = (SizeReq -> SizeReq -> SizeReq) -> [SizeReq] -> SizeReq
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 = WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
    contentArea :: Rect
contentArea = Rect -> Maybe Rect -> Rect
forall a. a -> Maybe a -> a
fromMaybe Rect
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) = Bool
-> Rect -> Double -> Seq (WidgetNode s e) -> (Seq Rect, Double)
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 (WidgetNode s e -> SizeReq) -> WidgetNode s e -> SizeReq
forall a b. (a -> b) -> a -> b
$ Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
0
    sizeReq2 :: SizeReq
sizeReq2 = WidgetNode s e -> SizeReq
sizeReq (WidgetNode s e -> SizeReq) -> WidgetNode s e -> SizeReq
forall a b. (a -> b) -> a -> b
$ Seq (WidgetNode s e) -> Int -> WidgetNode s e
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 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
oldHandlePos)
    valid2 :: Bool
valid2 = SizeReq -> Double -> Double -> Bool
sizeReqValid SizeReq
sizeReq2 Double
0 (Double
newSize Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
1 Double -> Double -> Double
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 = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== SplitCfg s e -> Maybe Bool
forall s e. SplitCfg s e -> Maybe Bool
_spcIgnoreChildResize SplitCfg s e
config
    sizeReqEquals :: Bool
sizeReqEquals = (SizeReq
sizeReq1, SizeReq
sizeReq2) (SizeReq, SizeReq) -> (SizeReq, SizeReq) -> Bool
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 = Maybe (WidgetData s Double) -> Bool
forall a. Maybe a -> Bool
isJust (SplitCfg s e -> Maybe (WidgetData s Double)
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 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
handleW) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
handlePos, Double
rh)
      | Bool
otherwise = (Double
rw, (Double
newSize Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
handleW) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
handlePos)
    (Double
w2, Double
h2)
      | Bool
isHorizontal = (Double
newSize Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
w1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
handleW, Double
rh)
      | Bool
otherwise = (Double
rw, Double
newSize Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
h1 Double -> Double -> Double
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 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
w1 Double -> Double -> Double
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 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
h1 Double -> Double -> Double
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 Double -> Double -> Double
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 Double -> Double -> Double
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 = ((Double -> WidgetRequest s e) -> WidgetRequest s e)
-> [Double -> WidgetRequest s e] -> [WidgetRequest s e]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Double -> WidgetRequest s e) -> Double -> WidgetRequest s e
forall a b. (a -> b) -> a -> b
$ Double
handlePos) (SplitCfg s e -> [Double -> WidgetRequest s e]
forall s e. SplitCfg s e -> [Double -> WidgetRequest s e]
_spcOnChangeReq SplitCfg s e
config)
    requestPos :: [WidgetRequest s e]
requestPos = SplitCfg s e -> Double -> [WidgetRequest s e]
forall s e. SplitCfg s e -> Double -> [WidgetRequest s e]
setModelPos SplitCfg s e
config Double
handlePos
    result :: WidgetResult s e
result = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node
      WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e) -> WidgetResult s e
forall a b. a -> (a -> b) -> b
& (WidgetNode s e -> Identity (WidgetNode s e))
-> WidgetResult s e -> Identity (WidgetResult s e)
forall s a. HasNode s a => Lens' s a
L.node ((WidgetNode s e -> Identity (WidgetNode s e))
 -> WidgetResult s e -> Identity (WidgetResult s e))
-> ((Widget s e -> Identity (Widget s e))
    -> WidgetNode s e -> Identity (WidgetNode s e))
-> (Widget s e -> Identity (Widget s e))
-> WidgetResult s e
-> Identity (WidgetResult s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
L.widget ((Widget s e -> Identity (Widget s e))
 -> WidgetResult s e -> Identity (WidgetResult s e))
-> Widget s e -> WidgetResult s e -> WidgetResult s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool -> SplitCfg s e -> SplitState -> Widget s e
forall e s.
WidgetEvent e =>
Bool -> SplitCfg s e -> SplitState -> Widget s e
makeSplit Bool
isHorizontal SplitCfg s e
config SplitState
newState
      WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e) -> WidgetResult s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> WidgetResult s e -> Identity (WidgetResult s e)
forall s a. HasRequests s a => Lens' s a
L.requests ((Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
 -> WidgetResult s e -> Identity (WidgetResult s e))
-> Seq (WidgetRequest s e) -> WidgetResult s e -> WidgetResult s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [WidgetRequest s e] -> Seq (WidgetRequest s e)
forall a. [a] -> Seq a
Seq.fromList ([WidgetRequest s e]
requestPos [WidgetRequest s e] -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. [a] -> [a] -> [a]
++ [WidgetRequest s e]
reqOnChange)
    newVps :: Seq Rect
newVps = [Rect] -> Seq Rect
forall a. [a] -> Seq a
Seq.fromList [Rect
rect1, Rect
rect2]
    resized :: (WidgetResult s e, Seq Rect)
resized
      | WidgetNode s e
node WidgetNode s e -> Getting Bool (WidgetNode s e) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> WidgetNode s e -> Const Bool (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Bool WidgetNodeInfo)
 -> WidgetNode s e -> Const Bool (WidgetNode s e))
-> ((Bool -> Const Bool Bool)
    -> WidgetNodeInfo -> Const Bool WidgetNodeInfo)
-> Getting Bool (WidgetNode s e) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> WidgetNodeInfo -> Const Bool WidgetNodeInfo
forall s a. HasVisible s a => Lens' s a
L.visible = (WidgetResult s e
result, Seq Rect
newVps)
      | Bool
otherwise = (WidgetNode s e -> WidgetResult s e
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 = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
0
    child2 :: WidgetNode s e
child2 = Seq (WidgetNode s e) -> Int -> WidgetNode s e
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 = (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
minSize1 (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
maxSize1 (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double -> Double
forall a. Num a => a -> a
abs (Double
vx Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
rx)), Double
0)
      | Bool
otherwise = (Double
0, Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
minSize1 (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
maxSize1 (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double -> Double
forall a. Num a => a -> a
abs (Double
vy Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
ry)))
    newPoint :: Point
newPoint
      | Bool
isHorizontal Bool -> Bool -> Bool
&& Double
tw Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
minSize2 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
maxDim = Double -> Double -> Point
Point (Double
maxDim Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
minSize2) Double
th
      | Bool
isHorizontal Bool -> Bool -> Bool
&& Double
maxDim Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
tw Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
maxSize2 = Double -> Double -> Point
Point (Double
maxDim Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
maxSize2) Double
th
      | Bool
isVertical Bool -> Bool -> Bool
&& Double
th Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
minSize2 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
maxDim = Double -> Double -> Point
Point Double
tw (Double
maxDim Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
minSize2)
      | Bool
isVertical Bool -> Bool -> Bool
&& Double
maxDim Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
th Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
maxSize2 = Double -> Double -> Point
Point Double
tw (Double
maxDim Double -> Double -> Double
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 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
maxDim Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
handlePos) Double
0
      | Bool
otherwise = Double -> Double -> Point
Point Double
0 (Double
ry Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
maxDim Double -> Double -> Double
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 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
rx) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
maxDim
      | Bool
otherwise = (Double
py Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
ry) Double -> Double -> Double
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 = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
0
    child2 :: WidgetNode s e
child2 = Seq (WidgetNode s e) -> Int -> WidgetNode s e
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 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
maxSize1 Double -> Double -> Double
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 = (WidgetNode s e
-> Getting SizeReq (WidgetNode s e) SizeReq -> SizeReq
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
 -> WidgetNode s e -> Const SizeReq (WidgetNode s e))
-> ((SizeReq -> Const SizeReq SizeReq)
    -> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> Getting SizeReq (WidgetNode s e) SizeReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo
forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW)
    | Bool
otherwise = (WidgetNode s e
-> Getting SizeReq (WidgetNode s e) SizeReq -> SizeReq
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
 -> WidgetNode s e -> Const SizeReq (WidgetNode s e))
-> ((SizeReq -> Const SizeReq SizeReq)
    -> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> Getting SizeReq (WidgetNode s e) SizeReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo
forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH)

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

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