{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StrictData #-}
module Monomer.Widgets.Containers.Split (
SplitCfg,
splitHandlePos,
splitHandlePosV,
splitHandleSize,
splitIgnoreChildResize,
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
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]
}
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)
}
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)
}
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
}
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)
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
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
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
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