{-# 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 {
forall s e. SplitCfg s e -> Maybe (WidgetData s Double)
_spcHandlePos :: Maybe (WidgetData s Double),
forall s e. SplitCfg s e -> Maybe Double
_spcHandleSize :: Maybe Double,
forall s e. SplitCfg s e -> Maybe Bool
_spcIgnoreChildResize :: Maybe Bool,
forall s e. SplitCfg s e -> [Double -> WidgetRequest s e]
_spcOnChangeReq :: [Double -> WidgetRequest s e]
}
instance Default (SplitCfg s e) where
def :: SplitCfg s e
def = SplitCfg {
_spcHandlePos :: Maybe (WidgetData s Double)
_spcHandlePos = forall a. Maybe a
Nothing,
_spcHandleSize :: Maybe Double
_spcHandleSize = forall a. Maybe a
Nothing,
_spcIgnoreChildResize :: Maybe Bool
_spcIgnoreChildResize = forall a. Maybe a
Nothing,
_spcOnChangeReq :: [Double -> WidgetRequest s e]
_spcOnChangeReq = []
}
instance Semigroup (SplitCfg s e) where
<> :: SplitCfg s e -> SplitCfg s e -> SplitCfg s e
(<>) SplitCfg s e
s1 SplitCfg s e
s2 = SplitCfg {
_spcHandlePos :: Maybe (WidgetData s Double)
_spcHandlePos = forall s e. SplitCfg s e -> Maybe (WidgetData s Double)
_spcHandlePos SplitCfg s e
s2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. SplitCfg s e -> Maybe (WidgetData s Double)
_spcHandlePos SplitCfg s e
s1,
_spcHandleSize :: Maybe Double
_spcHandleSize = forall s e. SplitCfg s e -> Maybe Double
_spcHandleSize SplitCfg s e
s2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. SplitCfg s e -> Maybe Double
_spcHandleSize SplitCfg s e
s1,
_spcIgnoreChildResize :: Maybe Bool
_spcIgnoreChildResize = forall s e. SplitCfg s e -> Maybe Bool
_spcIgnoreChildResize SplitCfg s e
s2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. SplitCfg s e -> Maybe Bool
_spcIgnoreChildResize SplitCfg s e
s1,
_spcOnChangeReq :: [Double -> WidgetRequest s e]
_spcOnChangeReq = forall s e. SplitCfg s e -> [Double -> WidgetRequest s e]
_spcOnChangeReq SplitCfg s e
s2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. SplitCfg s e -> [Double -> WidgetRequest s e]
_spcOnChangeReq SplitCfg s e
s1
}
instance Monoid (SplitCfg s e) where
mempty :: SplitCfg s e
mempty = forall a. Default a => a
def
instance WidgetEvent e => CmbOnChange (SplitCfg s e) Double e where
onChange :: (Double -> e) -> SplitCfg s e
onChange Double -> e
fn = forall a. Default a => a
def {
_spcOnChangeReq :: [Double -> WidgetRequest s e]
_spcOnChangeReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> e
fn]
}
instance CmbOnChangeReq (SplitCfg s e) s e Double where
onChangeReq :: (Double -> WidgetRequest s e) -> SplitCfg s e
onChangeReq Double -> WidgetRequest s e
req = forall a. Default a => a
def {
_spcOnChangeReq :: [Double -> WidgetRequest s e]
_spcOnChangeReq = [Double -> WidgetRequest s e
req]
}
splitHandlePos :: ALens' s Double -> SplitCfg s e
splitHandlePos :: forall s e. ALens' s Double -> SplitCfg s e
splitHandlePos ALens' s Double
field = forall a. Default a => a
def {
_spcHandlePos :: Maybe (WidgetData s Double)
_spcHandlePos = forall a. a -> Maybe a
Just (forall s a. ALens' s a -> WidgetData s a
WidgetLens ALens' s Double
field)
}
splitHandlePosV :: Double -> SplitCfg s e
splitHandlePosV :: forall s e. Double -> SplitCfg s e
splitHandlePosV Double
value = forall a. Default a => a
def {
_spcHandlePos :: Maybe (WidgetData s Double)
_spcHandlePos = forall a. a -> Maybe a
Just (forall s a. a -> WidgetData s a
WidgetValue Double
value)
}
splitHandleSize :: Double -> SplitCfg s e
splitHandleSize :: forall s e. Double -> SplitCfg s e
splitHandleSize Double
w = forall a. Default a => a
def {
_spcHandleSize :: Maybe Double
_spcHandleSize = forall a. a -> Maybe a
Just Double
w
}
splitIgnoreChildResize :: Bool -> SplitCfg s e
splitIgnoreChildResize :: forall s e. Bool -> SplitCfg s e
splitIgnoreChildResize Bool
ignore = forall a. Default a => a
def {
_spcIgnoreChildResize :: Maybe Bool
_spcIgnoreChildResize = forall a. a -> Maybe a
Just Bool
ignore
}
data SplitState = SplitState {
SplitState -> (SizeReq, SizeReq)
_spsPrevReqs :: (SizeReq, SizeReq),
SplitState -> Double
_spsMaxSize :: Double,
SplitState -> Bool
_spsHandlePosUserSet :: Bool,
SplitState -> Double
_spsHandlePos :: Double,
SplitState -> Rect
_spsHandleRect :: Rect
} deriving (SplitState -> SplitState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SplitState -> SplitState -> Bool
$c/= :: SplitState -> SplitState -> Bool
== :: SplitState -> SplitState -> Bool
$c== :: SplitState -> SplitState -> Bool
Eq, Int -> SplitState -> ShowS
[SplitState] -> ShowS
SplitState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SplitState] -> ShowS
$cshowList :: [SplitState] -> ShowS
show :: SplitState -> String
$cshow :: SplitState -> String
showsPrec :: Int -> SplitState -> ShowS
$cshowsPrec :: Int -> SplitState -> ShowS
Show, forall x. Rep SplitState x -> SplitState
forall x. SplitState -> Rep SplitState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SplitState x -> SplitState
$cfrom :: forall x. SplitState -> Rep SplitState x
Generic)
hsplit :: WidgetEvent e => (WidgetNode s e, WidgetNode s e) -> WidgetNode s e
hsplit :: forall e s.
WidgetEvent e =>
(WidgetNode s e, WidgetNode s e) -> WidgetNode s e
hsplit (WidgetNode s e, WidgetNode s e)
nodes = forall e s.
WidgetEvent e =>
[SplitCfg s e]
-> (WidgetNode s e, WidgetNode s e) -> WidgetNode s e
hsplit_ forall a. Default a => a
def (WidgetNode s e, WidgetNode s e)
nodes
hsplit_
:: WidgetEvent e
=> [SplitCfg s e] -> (WidgetNode s e, WidgetNode s e) -> WidgetNode s e
hsplit_ :: forall e s.
WidgetEvent e =>
[SplitCfg s e]
-> (WidgetNode s e, WidgetNode s e) -> WidgetNode s e
hsplit_ [SplitCfg s e]
configs (WidgetNode s e, WidgetNode s e)
nodes = forall e s.
WidgetEvent e =>
Bool
-> (WidgetNode s e, WidgetNode s e)
-> [SplitCfg s e]
-> WidgetNode s e
split_ Bool
True (WidgetNode s e, WidgetNode s e)
nodes [SplitCfg s e]
configs
vsplit :: WidgetEvent e => (WidgetNode s e, WidgetNode s e) -> WidgetNode s e
vsplit :: forall e s.
WidgetEvent e =>
(WidgetNode s e, WidgetNode s e) -> WidgetNode s e
vsplit (WidgetNode s e, WidgetNode s e)
nodes = forall e s.
WidgetEvent e =>
[SplitCfg s e]
-> (WidgetNode s e, WidgetNode s e) -> WidgetNode s e
vsplit_ forall a. Default a => a
def (WidgetNode s e, WidgetNode s e)
nodes
vsplit_
:: WidgetEvent e
=> [SplitCfg s e]
-> (WidgetNode s e, WidgetNode s e)
-> WidgetNode s e
vsplit_ :: forall e s.
WidgetEvent e =>
[SplitCfg s e]
-> (WidgetNode s e, WidgetNode s e) -> WidgetNode s e
vsplit_ [SplitCfg s e]
configs (WidgetNode s e, WidgetNode s e)
nodes = forall e s.
WidgetEvent e =>
Bool
-> (WidgetNode s e, WidgetNode s e)
-> [SplitCfg s e]
-> WidgetNode s e
split_ Bool
False (WidgetNode s e, WidgetNode s e)
nodes [SplitCfg s e]
configs
split_
:: WidgetEvent e
=> Bool
-> (WidgetNode s e, WidgetNode s e)
-> [SplitCfg s e]
-> WidgetNode s e
split_ :: forall e s.
WidgetEvent e =>
Bool
-> (WidgetNode s e, WidgetNode s e)
-> [SplitCfg s e]
-> WidgetNode s e
split_ Bool
isHorizontal (WidgetNode s e
node1, WidgetNode s e
node2) [SplitCfg s e]
configs = WidgetNode s e
newNode where
config :: SplitCfg s e
config = forall a. Monoid a => [a] -> a
mconcat [SplitCfg s e]
configs
state :: SplitState
state = SplitState {
_spsPrevReqs :: (SizeReq, SizeReq)
_spsPrevReqs = forall a. Default a => a
def,
_spsMaxSize :: Double
_spsMaxSize = Double
0,
_spsHandlePosUserSet :: Bool
_spsHandlePosUserSet = Bool
False,
_spsHandlePos :: Double
_spsHandlePos = Double
0.5,
_spsHandleRect :: Rect
_spsHandleRect = forall a. Default a => a
def
}
widget :: Widget s e
widget = forall e s.
WidgetEvent e =>
Bool -> SplitCfg s e -> SplitState -> Widget s e
makeSplit Bool
isHorizontal SplitCfg s e
config SplitState
state
widgetName :: WidgetType
widgetName = if Bool
isHorizontal then WidgetType
"hsplit" else WidgetType
"vsplit"
newNode :: WidgetNode s e
newNode = forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
widgetName Widget s e
widget
forall a b. a -> (a -> b) -> b
& forall s a. HasChildren s a => Lens' s a
L.children forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. [a] -> Seq a
Seq.fromList [WidgetNode s e
node1, WidgetNode s e
node2]
makeSplit :: WidgetEvent e => Bool -> SplitCfg s e -> SplitState -> Widget s e
makeSplit :: forall e s.
WidgetEvent e =>
Bool -> SplitCfg s e -> SplitState -> Widget s e
makeSplit Bool
isHorizontal SplitCfg s e
config SplitState
state = Widget s e
widget where
widget :: Widget s e
widget = forall a s e. WidgetModel a => a -> Container s e a -> Widget s e
createContainer SplitState
state forall a. Default a => a
def {
containerUseCustomCursor :: Bool
containerUseCustomCursor = Bool
True,
containerLayoutDirection :: LayoutDirection
containerLayoutDirection = Bool -> LayoutDirection
getLayoutDirection Bool
isHorizontal,
containerInit :: ContainerInitHandler s e
containerInit = ContainerInitHandler s e
init,
containerMerge :: ContainerMergeHandler s e SplitState
containerMerge = forall {p}.
WidgetEnv s e
-> WidgetNode s e -> p -> SplitState -> WidgetResult s e
merge,
containerHandleEvent :: ContainerEventHandler s e
containerHandleEvent = ContainerEventHandler s e
handleEvent,
containerGetSizeReq :: ContainerGetSizeReqHandler s e
containerGetSizeReq = forall s e. ContainerGetSizeReqHandler s e
getSizeReq,
containerResize :: ContainerResizeHandler s e
containerResize = ContainerResizeHandler s e
resize
}
handleW :: Double
handleW = forall a. a -> Maybe a -> a
fromMaybe Double
5 (forall s e. SplitCfg s e -> Maybe Double
_spcHandleSize SplitCfg s e
config)
init :: ContainerInitHandler s e
init WidgetEnv s e
wenv WidgetNode s e
node = WidgetResult s e
result where
useModelValue :: Double -> WidgetResult s e
useModelValue Double
value = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode where
newState :: SplitState
newState = SplitState
state {
_spsHandlePosUserSet :: Bool
_spsHandlePosUserSet = Bool
True,
_spsHandlePos :: Double
_spsHandlePos = Double
value
}
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall e s.
WidgetEvent e =>
Bool -> SplitCfg s e -> SplitState -> Widget s e
makeSplit Bool
isHorizontal SplitCfg s e
config SplitState
newState
result :: WidgetResult s e
result = case forall s e. WidgetEnv s e -> SplitCfg s e -> Maybe Double
getModelPos WidgetEnv s e
wenv SplitCfg s e
config of
Just Double
val
| Double
val forall a. Ord a => a -> a -> Bool
>= Double
0 Bool -> Bool -> Bool
&& Double
val forall a. Ord a => a -> a -> Bool
<= Double
1 -> Double -> WidgetResult s e
useModelValue Double
val
Maybe Double
_ -> forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node
merge :: WidgetEnv s e
-> WidgetNode s e -> p -> SplitState -> WidgetResult s e
merge WidgetEnv s e
wenv WidgetNode s e
newNode p
oldNode SplitState
oldState = WidgetResult s e
result where
oldHandlePos :: Double
oldHandlePos = SplitState -> Double
_spsHandlePos SplitState
oldState
modelPos :: Maybe Double
modelPos = forall s e. WidgetEnv s e -> SplitCfg s e -> Maybe Double
getModelPos WidgetEnv s e
wenv SplitCfg s e
config
newState :: SplitState
newState = SplitState
oldState {
_spsHandlePos :: Double
_spsHandlePos = forall a. a -> Maybe a -> a
fromMaybe Double
oldHandlePos Maybe Double
modelPos
}
result :: WidgetResult s e
result = forall s e. WidgetNode s e -> WidgetResult s e
resultNode forall a b. (a -> b) -> a -> b
$ WidgetNode s e
newNode
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall e s.
WidgetEvent e =>
Bool -> SplitCfg s e -> SplitState -> Widget s e
makeSplit Bool
isHorizontal SplitCfg s e
config SplitState
newState
handleEvent :: ContainerEventHandler s e
handleEvent WidgetEnv s e
wenv WidgetNode s e
node Path
target SystemEvent
evt = case SystemEvent
evt of
Move Point
point
| Bool
isTarget Bool -> Bool -> Bool
&& Bool
isDragging -> forall a. a -> Maybe a
Just WidgetResult s e
resultDrag
| Point -> Bool
isInHandle Point
point Bool -> Bool -> Bool
&& CursorIcon
curIcon forall a. Eq a => a -> a -> Bool
/= CursorIcon
dragIcon -> forall a. a -> Maybe a
Just WidgetResult s e
resultHover
| Bool -> Bool
not (Point -> Bool
isInHandle Point
point) Bool -> Bool -> Bool
&& Path
curPath forall a. Eq a => a -> a -> Bool
== Path
path -> forall a. a -> Maybe a
Just WidgetResult s e
resultReset
where
Point Double
px Double
py = Double -> Rect -> Point -> Seq (WidgetNode s e) -> Point
getValidHandlePos Double
maxSize Rect
vp Point
point Seq (WidgetNode s e)
children
newHandlePos :: Double
newHandlePos
| Bool
isHorizontal = (Double
px forall a. Num a => a -> a -> a
- Rect
vp forall s a. s -> Getting a s a -> a
^. forall s a. HasX s a => Lens' s a
L.x) forall a. Fractional a => a -> a -> a
/ Double
maxSize
| Bool
otherwise = (Double
py forall a. Num a => a -> a -> a
- Rect
vp forall s a. s -> Getting a s a -> a
^. forall s a. HasY s a => Lens' s a
L.y) forall a. Fractional a => a -> a -> a
/ Double
maxSize
newState :: SplitState
newState = SplitState
state {
_spsHandlePosUserSet :: Bool
_spsHandlePosUserSet = Bool
True,
_spsHandlePos :: Double
_spsHandlePos = Double
newHandlePos
}
resizeReq :: b -> Bool
resizeReq = forall a b. a -> b -> a
const Bool
True
tmpNode :: WidgetNode s e
tmpNode = WidgetNode s e
node
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall e s.
WidgetEvent e =>
Bool -> SplitCfg s e -> SplitState -> Widget s e
makeSplit Bool
isHorizontal SplitCfg s e
config SplitState
newState
newNode :: WidgetResult s e
newNode = forall s e.
Widget s e
-> WidgetEnv s e
-> WidgetNode s e
-> Rect
-> (Path -> Bool)
-> WidgetResult s e
widgetResize (WidgetNode s e
tmpNode forall s a. s -> Getting a s a -> a
^. forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s e
wenv WidgetNode s e
tmpNode Rect
vp forall {b}. b -> Bool
resizeReq
resultDrag :: WidgetResult s e
resultDrag
| Double
handlePos forall a. Eq a => a -> a -> Bool
/= Double
newHandlePos = WidgetResult s e
newNode
forall a b. a -> (a -> b) -> b
& forall s a. HasRequests s a => Lens' s a
L.requests forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ forall a. [a] -> Seq a
Seq.fromList [forall {s} {e}. WidgetRequest s e
cursorIconReq, forall {s} {e}. WidgetRequest s e
RenderOnce]
| Bool
otherwise = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [forall {s} {e}. WidgetRequest s e
cursorIconReq]
resultHover :: WidgetResult s e
resultHover = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [forall {s} {e}. WidgetRequest s e
cursorIconReq]
resultReset :: WidgetResult s e
resultReset = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [forall s e. WidgetId -> WidgetRequest s e
ResetCursorIcon WidgetId
widgetId]
SystemEvent
_ -> forall a. Maybe a
Nothing
where
maxSize :: Double
maxSize = SplitState -> Double
_spsMaxSize SplitState
state
handlePos :: Double
handlePos = SplitState -> Double
_spsHandlePos SplitState
state
handleRect :: Rect
handleRect = SplitState -> Rect
_spsHandleRect SplitState
state
widgetId :: WidgetId
widgetId = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId
path :: Path
path = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasPath s a => Lens' s a
L.path
vp :: Rect
vp = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasViewport s a => Lens' s a
L.viewport
children :: Seq (WidgetNode s e)
children = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasChildren s a => Lens' s a
L.children
isTarget :: Bool
isTarget = Path
target forall a. Eq a => a -> a -> Bool
== WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasPath s a => Lens' s a
L.path
(Path
curPath, CursorIcon
curIcon) = forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def (WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasCursor s a => Lens' s a
L.cursor)
isDragging :: Bool
isDragging = forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodePressed WidgetEnv s e
wenv WidgetNode s e
node
isInHandle :: Point -> Bool
isInHandle Point
p = Point -> Rect -> Bool
pointInRect Point
p Rect
handleRect
dragIcon :: CursorIcon
dragIcon
| Bool
isHorizontal = CursorIcon
CursorSizeH
| Bool
otherwise = CursorIcon
CursorSizeV
cursorIconReq :: WidgetRequest s e
cursorIconReq = forall s e. WidgetId -> CursorIcon -> WidgetRequest s e
SetCursorIcon WidgetId
widgetId CursorIcon
dragIcon
getSizeReq :: ContainerGetSizeReqHandler s e
getSizeReq :: forall s e. ContainerGetSizeReqHandler s e
getSizeReq WidgetEnv s e
wenv WidgetNode s e
node Seq (WidgetNode s e)
children = (SizeReq
reqW, SizeReq
reqH) where
node1 :: WidgetNode s e
node1 = forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
0
node2 :: WidgetNode s e
node2 = forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
1
reqW1 :: SizeReq
reqW1 = WidgetNode s e
node1 forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW
reqH1 :: SizeReq
reqH1 = WidgetNode s e
node1 forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH
reqW2 :: SizeReq
reqW2 = WidgetNode s e
node2 forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW
reqH2 :: SizeReq
reqH2 = WidgetNode s e
node2 forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH
reqWS :: SizeReq
reqWS = Double -> SizeReq
fixedSize Double
handleW
reqW :: SizeReq
reqW
| Bool
isHorizontal = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 SizeReq -> SizeReq -> SizeReq
sizeReqMergeSum [SizeReq
reqWS, SizeReq
reqW1, SizeReq
reqW2]
| Bool
otherwise = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 SizeReq -> SizeReq -> SizeReq
sizeReqMergeMax [SizeReq
reqW1, SizeReq
reqW2]
reqH :: SizeReq
reqH
| Bool
isHorizontal = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 SizeReq -> SizeReq -> SizeReq
sizeReqMergeMax [SizeReq
reqH1, SizeReq
reqH2]
| Bool
otherwise = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 SizeReq -> SizeReq -> SizeReq
sizeReqMergeSum [SizeReq
reqWS, SizeReq
reqH1, SizeReq
reqH2]
resize :: ContainerResizeHandler s e
resize WidgetEnv s e
wenv WidgetNode s e
node Rect
viewport Seq (WidgetNode s e)
children = (WidgetResult s e, Seq Rect)
resized where
style :: StyleState
style = forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
contentArea :: Rect
contentArea = forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def (StyleState -> Rect -> Maybe Rect
removeOuterBounds StyleState
style Rect
viewport)
Rect Double
rx Double
ry Double
rw Double
rh = Rect
contentArea
(Seq Rect
areas, Double
newSize) = forall s e.
Bool
-> Rect -> Double -> Seq (WidgetNode s e) -> (Seq Rect, Double)
assignStackAreas Bool
isHorizontal Rect
contentArea Double
0 Seq (WidgetNode s e)
children
oldHandlePos :: Double
oldHandlePos = SplitState -> Double
_spsHandlePos SplitState
state
sizeReq1 :: SizeReq
sizeReq1 = WidgetNode s e -> SizeReq
sizeReq forall a b. (a -> b) -> a -> b
$ forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
0
sizeReq2 :: SizeReq
sizeReq2 = WidgetNode s e -> SizeReq
sizeReq forall a b. (a -> b) -> a -> b
$ forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
1
valid1 :: Bool
valid1 = SizeReq -> Double -> Double -> Bool
sizeReqValid SizeReq
sizeReq1 Double
0 (Double
newSize forall a. Num a => a -> a -> a
* Double
oldHandlePos)
valid2 :: Bool
valid2 = SizeReq -> Double -> Double -> Bool
sizeReqValid SizeReq
sizeReq2 Double
0 (Double
newSize forall a. Num a => a -> a -> a
* (Double
1 forall a. Num a => a -> a -> a
- Double
oldHandlePos))
validSize :: Bool
validSize = Bool
valid1 Bool -> Bool -> Bool
&& Bool
valid2
handlePosUserSet :: Bool
handlePosUserSet = SplitState -> Bool
_spsHandlePosUserSet SplitState
state
ignoreSizeReq :: Bool
ignoreSizeReq = forall a. a -> Maybe a
Just Bool
True forall a. Eq a => a -> a -> Bool
== forall s e. SplitCfg s e -> Maybe Bool
_spcIgnoreChildResize SplitCfg s e
config
sizeReqEquals :: Bool
sizeReqEquals = (SizeReq
sizeReq1, SizeReq
sizeReq2) forall a. Eq a => a -> a -> Bool
== SplitState -> (SizeReq, SizeReq)
_spsPrevReqs SplitState
state
resizeNeeded :: Bool
resizeNeeded = Bool -> Bool
not (Bool
sizeReqEquals Bool -> Bool -> Bool
&& Bool
handlePosUserSet)
customPos :: Bool
customPos = forall a. Maybe a -> Bool
isJust (forall s e. SplitCfg s e -> Maybe (WidgetData s Double)
_spcHandlePos SplitCfg s e
config)
useOldPos :: Bool
useOldPos = Bool
customPos Bool -> Bool -> Bool
|| Bool
ignoreSizeReq Bool -> Bool -> Bool
|| Bool
sizeReqEquals
initialPos :: Double
initialPos = Seq (WidgetNode s e) -> Double
initialHandlePos Seq (WidgetNode s e)
children
handlePos :: Double
handlePos
| Bool
useOldPos Bool -> Bool -> Bool
&& Bool
handlePosUserSet Bool -> Bool -> Bool
&& Bool
validSize = Double
oldHandlePos
| Bool
resizeNeeded = Double -> Double -> Rect -> Seq (WidgetNode s e) -> Double
calcHandlePos Double
newSize Double
initialPos Rect
viewport Seq (WidgetNode s e)
children
| Bool
otherwise = Double -> Double -> Rect -> Seq (WidgetNode s e) -> Double
calcHandlePos Double
newSize Double
oldHandlePos Rect
viewport Seq (WidgetNode s e)
children
(Double
w1, Double
h1)
| Bool
isHorizontal = ((Double
newSize forall a. Num a => a -> a -> a
- Double
handleW) forall a. Num a => a -> a -> a
* Double
handlePos, Double
rh)
| Bool
otherwise = (Double
rw, (Double
newSize forall a. Num a => a -> a -> a
- Double
handleW) forall a. Num a => a -> a -> a
* Double
handlePos)
(Double
w2, Double
h2)
| Bool
isHorizontal = (Double
newSize forall a. Num a => a -> a -> a
- Double
w1 forall a. Num a => a -> a -> a
- Double
handleW, Double
rh)
| Bool
otherwise = (Double
rw, Double
newSize forall a. Num a => a -> a -> a
- Double
h1 forall a. Num a => a -> a -> a
- Double
handleW)
rect1 :: Rect
rect1 = Double -> Double -> Double -> Double -> Rect
Rect Double
rx Double
ry Double
w1 Double
h1
rect2 :: Rect
rect2
| Bool
isHorizontal = Double -> Double -> Double -> Double -> Rect
Rect (Double
rx forall a. Num a => a -> a -> a
+ Double
w1 forall a. Num a => a -> a -> a
+ Double
handleW) Double
ry Double
w2 Double
h2
| Bool
otherwise = Double -> Double -> Double -> Double -> Rect
Rect Double
rx (Double
ry forall a. Num a => a -> a -> a
+ Double
h1 forall a. Num a => a -> a -> a
+ Double
handleW) Double
w2 Double
h2
newHandleRect :: Rect
newHandleRect
| Bool
isHorizontal = Double -> Double -> Double -> Double -> Rect
Rect (Double
rx forall a. Num a => a -> a -> a
+ Double
w1) Double
ry Double
handleW Double
h1
| Bool
otherwise = Double -> Double -> Double -> Double -> Rect
Rect Double
rx (Double
ry forall a. Num a => a -> a -> a
+ Double
h1) Double
w1 Double
handleW
newState :: SplitState
newState = SplitState
state {
_spsHandlePos :: Double
_spsHandlePos = Double
handlePos,
_spsHandleRect :: Rect
_spsHandleRect = Rect
newHandleRect,
_spsMaxSize :: Double
_spsMaxSize = Double
newSize,
_spsPrevReqs :: (SizeReq, SizeReq)
_spsPrevReqs = (SizeReq
sizeReq1, SizeReq
sizeReq2)
}
reqOnChange :: [WidgetRequest s e]
reqOnChange = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ Double
handlePos) (forall s e. SplitCfg s e -> [Double -> WidgetRequest s e]
_spcOnChangeReq SplitCfg s e
config)
requestPos :: [WidgetRequest s e]
requestPos = forall s e. SplitCfg s e -> Double -> [WidgetRequest s e]
setModelPos SplitCfg s e
config Double
handlePos
result :: WidgetResult s e
result = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node
forall a b. a -> (a -> b) -> b
& forall s a. HasNode s a => Lens' s a
L.node forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall e s.
WidgetEvent e =>
Bool -> SplitCfg s e -> SplitState -> Widget s e
makeSplit Bool
isHorizontal SplitCfg s e
config SplitState
newState
forall a b. a -> (a -> b) -> b
& forall s a. HasRequests s a => Lens' s a
L.requests forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. [a] -> Seq a
Seq.fromList ([WidgetRequest s e]
requestPos forall a. [a] -> [a] -> [a]
++ [WidgetRequest s e]
reqOnChange)
newVps :: Seq Rect
newVps = forall a. [a] -> Seq a
Seq.fromList [Rect
rect1, Rect
rect2]
resized :: (WidgetResult s e, Seq Rect)
resized
| WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasVisible s a => Lens' s a
L.visible = (WidgetResult s e
result, Seq Rect
newVps)
| Bool
otherwise = (forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node, Seq Rect
newVps)
getValidHandlePos :: Double -> Rect -> Point -> Seq (WidgetNode s e) -> Point
getValidHandlePos Double
maxDim Rect
vp Point
handleXY Seq (WidgetNode s e)
children = Point -> Point -> Point
addPoint Point
origin Point
newPoint where
Rect Double
rx Double
ry Double
_ Double
_ = Rect
vp
Point Double
vx Double
vy = Rect -> Point -> Point
rectBoundedPoint Rect
vp Point
handleXY
origin :: Point
origin = Double -> Double -> Point
Point Double
rx Double
ry
isVertical :: Bool
isVertical = Bool -> Bool
not Bool
isHorizontal
child1 :: WidgetNode s e
child1 = forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
0
child2 :: WidgetNode s e
child2 = forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
1
minSize1 :: Double
minSize1 = SizeReq -> Double
sizeReqMin (WidgetNode s e -> SizeReq
sizeReq WidgetNode s e
child1)
maxSize1 :: Double
maxSize1 = SizeReq -> Double
sizeReqMax (WidgetNode s e -> SizeReq
sizeReq WidgetNode s e
child1)
minSize2 :: Double
minSize2 = SizeReq -> Double
sizeReqMin (WidgetNode s e -> SizeReq
sizeReq WidgetNode s e
child2)
maxSize2 :: Double
maxSize2 = SizeReq -> Double
sizeReqMax (WidgetNode s e -> SizeReq
sizeReq WidgetNode s e
child2)
(Double
tw, Double
th)
| Bool
isHorizontal = (forall a. Ord a => a -> a -> a
max Double
minSize1 (forall a. Ord a => a -> a -> a
min Double
maxSize1 forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
abs (Double
vx forall a. Num a => a -> a -> a
- Double
rx)), Double
0)
| Bool
otherwise = (Double
0, forall a. Ord a => a -> a -> a
max Double
minSize1 (forall a. Ord a => a -> a -> a
min Double
maxSize1 forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
abs (Double
vy forall a. Num a => a -> a -> a
- Double
ry)))
newPoint :: Point
newPoint
| Bool
isHorizontal Bool -> Bool -> Bool
&& Double
tw forall a. Num a => a -> a -> a
+ Double
minSize2 forall a. Ord a => a -> a -> Bool
> Double
maxDim = Double -> Double -> Point
Point (Double
maxDim forall a. Num a => a -> a -> a
- Double
minSize2) Double
th
| Bool
isHorizontal Bool -> Bool -> Bool
&& Double
maxDim forall a. Num a => a -> a -> a
- Double
tw forall a. Ord a => a -> a -> Bool
> Double
maxSize2 = Double -> Double -> Point
Point (Double
maxDim forall a. Num a => a -> a -> a
- Double
maxSize2) Double
th
| Bool
isVertical Bool -> Bool -> Bool
&& Double
th forall a. Num a => a -> a -> a
+ Double
minSize2 forall a. Ord a => a -> a -> Bool
> Double
maxDim = Double -> Double -> Point
Point Double
tw (Double
maxDim forall a. Num a => a -> a -> a
- Double
minSize2)
| Bool
isVertical Bool -> Bool -> Bool
&& Double
maxDim forall a. Num a => a -> a -> a
- Double
th forall a. Ord a => a -> a -> Bool
> Double
maxSize2 = Double -> Double -> Point
Point Double
tw (Double
maxDim forall a. Num a => a -> a -> a
- Double
maxSize2)
| Bool
otherwise = Double -> Double -> Point
Point Double
tw Double
th
calcHandlePos :: Double -> Double -> Rect -> Seq (WidgetNode s e) -> Double
calcHandlePos Double
maxDim Double
handlePos Rect
vp Seq (WidgetNode s e)
children = Double
newPos where
Rect Double
rx Double
ry Double
_ Double
_ = Rect
vp
handleXY :: Point
handleXY
| Bool
isHorizontal = Double -> Double -> Point
Point (Double
rx forall a. Num a => a -> a -> a
+ Double
maxDim forall a. Num a => a -> a -> a
* Double
handlePos) Double
0
| Bool
otherwise = Double -> Double -> Point
Point Double
0 (Double
ry forall a. Num a => a -> a -> a
+ Double
maxDim forall a. Num a => a -> a -> a
* Double
handlePos)
Point Double
px Double
py = Double -> Rect -> Point -> Seq (WidgetNode s e) -> Point
getValidHandlePos Double
maxDim Rect
vp Point
handleXY Seq (WidgetNode s e)
children
newPos :: Double
newPos
| Bool
isHorizontal = (Double
px forall a. Num a => a -> a -> a
- Double
rx) forall a. Fractional a => a -> a -> a
/ Double
maxDim
| Bool
otherwise = (Double
py forall a. Num a => a -> a -> a
- Double
ry) forall a. Fractional a => a -> a -> a
/ Double
maxDim
initialHandlePos :: Seq (WidgetNode s e) -> Double
initialHandlePos Seq (WidgetNode s e)
children = Double
handlePos where
child1 :: WidgetNode s e
child1 = forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
0
child2 :: WidgetNode s e
child2 = forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
1
maxSize1 :: Double
maxSize1 = SizeReq -> Double
sizeReqMaxBounded (WidgetNode s e -> SizeReq
sizeReq WidgetNode s e
child1)
maxSize2 :: Double
maxSize2 = SizeReq -> Double
sizeReqMaxBounded (WidgetNode s e -> SizeReq
sizeReq WidgetNode s e
child2)
handlePos :: Double
handlePos = Double
maxSize1 forall a. Fractional a => a -> a -> a
/ (Double
maxSize1 forall a. Num a => a -> a -> a
+ Double
maxSize2)
selector :: Rect -> Double
selector
| Bool
isHorizontal = Rect -> Double
_rW
| Bool
otherwise = Rect -> Double
_rH
sizeReq :: WidgetNode s e -> SizeReq
sizeReq
| Bool
isHorizontal = (forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW)
| Bool
otherwise = (forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH)
setModelPos :: SplitCfg s e -> Double -> [WidgetRequest s e]
setModelPos :: forall s e. SplitCfg s e -> Double -> [WidgetRequest s e]
setModelPos SplitCfg s e
cfg
| forall a. Maybe a -> Bool
isJust (forall s e. SplitCfg s e -> Maybe (WidgetData s Double)
_spcHandlePos SplitCfg s e
cfg) = forall s a e. WidgetData s a -> a -> [WidgetRequest s e]
widgetDataSet (forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall s e. SplitCfg s e -> Maybe (WidgetData s Double)
_spcHandlePos SplitCfg s e
cfg)
| Bool
otherwise = forall a b. a -> b -> a
const []
getModelPos :: WidgetEnv s e -> SplitCfg s e -> Maybe Double
getModelPos :: forall s e. WidgetEnv s e -> SplitCfg s e -> Maybe Double
getModelPos WidgetEnv s e
wenv SplitCfg s e
cfg
| forall a. Maybe a -> Bool
isJust Maybe (WidgetData s Double)
handlePosL = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall s a. s -> WidgetData s a -> a
widgetDataGet s
model (forall a. HasCallStack => Maybe a -> a
fromJust Maybe (WidgetData s Double)
handlePosL)
| Bool
otherwise = forall a. Maybe a
Nothing
where
model :: s
model = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasModel s a => Lens' s a
L.model
handlePosL :: Maybe (WidgetData s Double)
handlePosL = forall s e. SplitCfg s e -> Maybe (WidgetData s Double)
_spcHandlePos SplitCfg s e
cfg