module SizingF(sizingF) where
import LoopLow(loopThroughLowF)
import Spops(mapAccumlSP)
import LayoutRequest
import FRequest
import Geometry(Rect(..))
import Sizing(newSize)
sizingF :: Sizing -> F i o -> F i o
sizingF = SP (Either TCommand TEvent) (Either TCommand TEvent)
-> F i o -> F i o
forall i o.
SP (Either TCommand TEvent) (Either TCommand TEvent)
-> F i o -> F i o
loopThroughLowF (SP (Either TCommand TEvent) (Either TCommand TEvent)
-> F i o -> F i o)
-> (Sizing -> SP (Either TCommand TEvent) (Either TCommand TEvent))
-> Sizing
-> F i o
-> F i o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sizing -> SP (Either TCommand TEvent) (Either TCommand TEvent)
forall a.
Sizing
-> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse))
sizingSP
sizingSP :: Sizing
-> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse))
sizingSP Sizing
sizing = (Maybe (Maybe Point, Point, Bool, Bool)
-> Either (a, FRequest) (a, FResponse)
-> (Maybe (Maybe Point, Point, Bool, Bool),
Either (a, FRequest) (a, FResponse)))
-> Maybe (Maybe Point, Point, Bool, Bool)
-> SP
(Either (a, FRequest) (a, FResponse))
(Either (a, FRequest) (a, FResponse))
forall t a b. (t -> a -> (t, b)) -> t -> SP a b
mapAccumlSP Maybe (Maybe Point, Point, Bool, Bool)
-> Either (a, FRequest) (a, FResponse)
-> (Maybe (Maybe Point, Point, Bool, Bool),
Either (a, FRequest) (a, FResponse))
forall a.
Maybe (Maybe Point, Point, Bool, Bool)
-> Either (a, FRequest) (a, FResponse)
-> (Maybe (Maybe Point, Point, Bool, Bool),
Either (a, FRequest) (a, FResponse))
sizingT Maybe (Maybe Point, Point, Bool, Bool)
forall a. Maybe a
state0
where
state0 :: Maybe a
state0 = Maybe a
forall a. Maybe a
Nothing
sizingT :: Maybe (Maybe Point, Point, Bool, Bool)
-> Either (a, FRequest) (a, FResponse)
-> (Maybe (Maybe Point, Point, Bool, Bool),
Either (a, FRequest) (a, FResponse))
sizingT Maybe (Maybe Point, Point, Bool, Bool)
Nothing Either (a, FRequest) (a, FResponse)
msg =
case Either (a, FRequest) (a, FResponse)
msg of
Left (a
path,LCmd (LayoutRequest (Layout Point
size' Bool
fh' Bool
fv' Int -> Point
wa' Int -> Point
ha' [Point]
rps' Maybe (Point, Point, Alignment)
wanted'))) ->
((Maybe Point, Point, Bool, Bool)
-> Maybe (Maybe Point, Point, Bool, Bool)
forall a. a -> Maybe a
Just (Maybe Point
forall a. Maybe a
Nothing,Point
size',Bool
fh',Bool
fv'),Either (a, FRequest) (a, FResponse)
msg)
Either (a, FRequest) (a, FResponse)
_ -> (Maybe (Maybe Point, Point, Bool, Bool)
forall a. Maybe a
Nothing,Either (a, FRequest) (a, FResponse)
msg)
sizingT s :: Maybe (Maybe Point, Point, Bool, Bool)
s@(Just state :: (Maybe Point, Point, Bool, Bool)
state@(Maybe Point
optpos,Point
size,Bool
fh,Bool
fv)) Either (a, FRequest) (a, FResponse)
msg =
case Either (a, FRequest) (a, FResponse)
msg of
Left (a
path,LCmd (LayoutRequest r :: LayoutRequest
r@(Layout Point
size' Bool
fh' Bool
fv' Int -> Point
wa' Int -> Point
ha' [Point]
rps' Maybe (Point, Point, Alignment)
wanted'))) ->
case ((Maybe Point, Point, Bool, Bool)
state' (Maybe Point, Point, Bool, Bool)
-> (Maybe Point, Point, Bool, Bool) -> Bool
forall a. Eq a => a -> a -> Bool
== (Maybe Point, Point, Bool, Bool)
state,Maybe Point
optpos) of
(Bool
True,Just Point
pos) -> (Maybe (Maybe Point, Point, Bool, Bool)
s,(a, FResponse) -> Either (a, FRequest) (a, FResponse)
forall a b. b -> Either a b
Right (a
path,LayoutResponse -> FResponse
LEvt (Rect -> LayoutResponse
LayoutPlace (Point -> Point -> Rect
Rect Point
pos Point
size))))
(Bool, Maybe Point)
_ ->
((Maybe Point, Point, Bool, Bool)
-> Maybe (Maybe Point, Point, Bool, Bool)
forall a. a -> Maybe a
Just (Maybe Point, Point, Bool, Bool)
state',Either (a, FRequest) (a, FResponse)
forall b. Either (a, FRequest) b
msg')
where size'' :: Point
size'' = Sizing -> Point -> Point -> Point
newSize Sizing
sizing Point
size Point
size'
state' :: (Maybe Point, Point, Bool, Bool)
state' = (Maybe Point
optpos,Point
size'',Bool
fh',Bool
fv')
msg' :: Either (a, FRequest) b
msg' = (a, FRequest) -> Either (a, FRequest) b
forall a b. a -> Either a b
Left (a
path,LayoutRequest -> FRequest
layoutRequestCmd LayoutRequest
r{minsize :: Point
minsize=Point
size''})
Right (a
_,LEvt (LayoutPlace rect :: Rect
rect@(Rect Point
pos' Point
size'))) -> ((Maybe Point, Point, Bool, Bool)
-> Maybe (Maybe Point, Point, Bool, Bool)
forall a. a -> Maybe a
Just (Point -> Maybe Point
forall a. a -> Maybe a
Just Point
pos',Point
size',Bool
fh,Bool
fv),Either (a, FRequest) (a, FResponse)
msg)
Either (a, FRequest) (a, FResponse)
_ -> (Maybe (Maybe Point, Point, Bool, Bool)
s,Either (a, FRequest) (a, FResponse)
msg)