module PopupGroupF(popupGroupF,rootPopupF) where
import Command
import CompOps((>=^^<), (>^^=<))
import Dlayout(unmappedGroupF)
import Sizing(Sizing(..))
import Shells(unmappedShellF)
import Fudget
import FRequest
import Geometry(psub,pP)
import LayoutRequest
import LoopLow
import ParK
import Popupmsg
import MapstateK
import SpEither(filterRightSP)
import Spops
= ([FRequest]
-> K (Either (Maybe Size) b) (Either Any d)
-> F b d
-> F (Either (Either (Maybe Size) b) b) (Either (Either Any d) d))
-> (Size -> Size, [WindowAttributes], K b d)
-> F b d
-> F (PopupMsg b) d
forall c b d t b b a1 d.
([FRequest]
-> K (Either (Maybe Size) c) (Either b d)
-> t
-> F (Either (Either (Maybe Size) b) b) (Either a1 d))
-> (Size -> Size, [WindowAttributes], K c d)
-> t
-> F (PopupMsg b) d
popupF (Sizing
-> [FRequest]
-> K (Either (Maybe Size) b) (Either Any d)
-> F b d
-> F (Either (Either (Maybe Size) b) b) (Either (Either Any d) d)
forall a b c d.
Sizing
-> [FRequest] -> K a b -> F c d -> F (Either a c) (Either b d)
unmappedGroupF Sizing
Dynamic)
= ([FRequest]
-> K (Either (Maybe Size) b) (Either Any d)
-> F b d
-> F (Either (Either (Maybe Size) b) b) (Either (Either Any d) d))
-> (Size -> Size, [WindowAttributes], K b d)
-> F b d
-> F (PopupMsg b) d
forall c b d t b b a1 d.
([FRequest]
-> K (Either (Maybe Size) c) (Either b d)
-> t
-> F (Either (Either (Maybe Size) b) b) (Either a1 d))
-> (Size -> Size, [WindowAttributes], K c d)
-> t
-> F (PopupMsg b) d
popupF [FRequest]
-> K (Either (Maybe Size) b) (Either Any d)
-> F b d
-> F (Either (Either (Maybe Size) b) b) (Either (Either Any d) d)
forall (t :: * -> *) a b c d.
Foldable t =>
t FRequest -> K a b -> F c d -> F (Either a c) (Either b d)
unmappedShellF
[FRequest]
-> K (Either (Maybe Size) c) (Either b d)
-> t
-> F (Either (Either (Maybe Size) b) b) (Either a1 d)
grF (Size -> Size
offset, [WindowAttributes]
wattrs, K c d
k) t
f =
let post :: (a, FRequest) -> [Message (a, FRequest) (a, FResponse)]
post (a
tag, FRequest
cmd) =
case FRequest
cmd of
LCmd LayoutMessage
req ->
case LayoutMessage
req of
LayoutRequest (Layout {minsize :: LayoutRequest -> Size
minsize=Size
size}) ->
[(a, FResponse) -> Message (a, FRequest) (a, FResponse)
forall a b. b -> Message a b
High (a
tag, LayoutResponse -> FResponse
LEvt (LayoutResponse -> FResponse) -> LayoutResponse -> FResponse
forall a b. (a -> b) -> a -> b
$ Size -> LayoutResponse
LayoutSize Size
size)]
LayoutMessage
_ -> []
FRequest
cmd' -> [(a, FRequest) -> Message (a, FRequest) (a, FResponse)
forall a b. a -> Message a b
Low (a
tag, FRequest
cmd')]
pre :: Message (a, FResponse) (a, FResponse) -> [(a, FResponse)]
pre Message (a, FResponse) (a, FResponse)
ev =
case Message (a, FResponse) (a, FResponse)
ev of
High (a, FResponse)
ev' -> [(a, FResponse)
ev']
Low (a
_, LEvt (LayoutPlace Rect
_)) -> []
Low (a, FResponse)
tev -> [(a, FResponse)
tev]
distr :: PopupMsg b -> [Either (Either (Maybe Size) b) b]
distr (Popup Size
p b
x) = [b -> Either (Either (Maybe Size) b) b
forall a b. b -> Either a b
Right b
x, Either (Maybe Size) b -> Either (Either (Maybe Size) b) b
forall a b. a -> Either a b
Left (Maybe Size -> Either (Maybe Size) b
forall a b. a -> Either a b
Left (Size -> Maybe Size
forall a. a -> Maybe a
Just Size
p))]
distr PopupMsg b
Popdown = [Either (Maybe Size) b -> Either (Either (Maybe Size) b) b
forall a b. a -> Either a b
Left (Maybe Size -> Either (Maybe Size) b
forall a b. a -> Either a b
Left Maybe Size
forall a. Maybe a
Nothing)]
startcmds :: [FRequest]
startcmds = [XCommand -> FRequest
XCmd (XCommand -> FRequest) -> XCommand -> FRequest
forall a b. (a -> b) -> a -> b
$ [WindowAttributes] -> XCommand
ChangeWindowAttributes [WindowAttributes]
wattrs]
in (SP (Either a1 d) d
forall a1 b. SP (Either a1 b) b
filterRightSP SP (Either a1 d) d
-> F (Either (Either (Maybe Size) b) b) (Either a1 d)
-> F (Either (Either (Maybe Size) b) b) d
forall a b e. SP a b -> F e a -> F e b
>^^=<
SP TCommand (FCommand (Path, FResponse))
-> SP (FEvent (Path, FResponse)) (Path, FResponse)
-> F (Either (Either (Maybe Size) b) b) (Either a1 d)
-> F (Either (Either (Maybe Size) b) b) (Either a1 d)
forall a b c.
SP TCommand (FCommand a)
-> SP (FEvent a) (Path, FResponse) -> F b c -> F b c
loopLow ((TCommand -> [FCommand (Path, FResponse)])
-> SP TCommand (FCommand (Path, FResponse))
forall t b. (t -> [b]) -> SP t b
concmapSP TCommand -> [FCommand (Path, FResponse)]
forall a. (a, FRequest) -> [Message (a, FRequest) (a, FResponse)]
post)
((FEvent (Path, FResponse) -> [(Path, FResponse)])
-> SP (FEvent (Path, FResponse)) (Path, FResponse)
forall t b. (t -> [b]) -> SP t b
concmapSP FEvent (Path, FResponse) -> [(Path, FResponse)]
forall a. Message (a, FResponse) (a, FResponse) -> [(a, FResponse)]
pre)
([FRequest]
-> K (Either (Maybe Size) c) (Either b d)
-> t
-> F (Either (Either (Maybe Size) b) b) (Either a1 d)
grF [FRequest]
startcmds (K (Maybe Size) b -> K c d -> K (Either (Maybe Size) c) (Either b d)
forall a b c d. K a b -> K c d -> K (Either a c) (Either b d)
compK ((Size -> Size) -> K (Maybe Size) b
forall ho. (Size -> Size) -> K (Maybe Size) ho
placeK Size -> Size
offset) K c d
k) t
f)) F (Either (Either (Maybe Size) b) b) d
-> SP (PopupMsg b) (Either (Either (Maybe Size) b) b)
-> F (PopupMsg b) d
forall c d e. F c d -> SP e c -> F e d
>=^^<
(PopupMsg b -> [Either (Either (Maybe Size) b) b])
-> SP (PopupMsg b) (Either (Either (Maybe Size) b) b)
forall t b. (t -> [b]) -> SP t b
concatMapSP PopupMsg b -> [Either (Either (Maybe Size) b) b]
forall b b. PopupMsg b -> [Either (Either (Maybe Size) b) b]
distr
placeK :: (Size -> Size) -> K (Maybe Size) ho
placeK Size -> Size
offset = ((Bool, Size)
-> KEvent (Maybe Size) -> ((Bool, Size), [KCommand ho]))
-> (Bool, Size) -> K (Maybe Size) ho
forall t hi ho.
(t -> KEvent hi -> (t, [KCommand ho])) -> t -> K hi ho
mapstateK (Bool, Size)
-> KEvent (Maybe Size) -> ((Bool, Size), [KCommand ho])
forall b.
(Bool, Size)
-> KEvent (Maybe Size) -> ((Bool, Size), [Message FRequest b])
sizeT (Bool
False,Int -> Int -> Size
pP Int
0 Int
0)
where
sizeT :: (Bool, Size)
-> KEvent (Maybe Size) -> ((Bool, Size), [Message FRequest b])
sizeT s :: (Bool, Size)
s@(Bool
mapped,Size
size) KEvent (Maybe Size)
msg =
case KEvent (Maybe Size)
msg of
High (Just Size
p) ->
((Bool
True,Size
size),
[FRequest -> Message FRequest b
forall a b. a -> Message a b
Low (FRequest -> Message FRequest b) -> FRequest -> Message FRequest b
forall a b. (a -> b) -> a -> b
$ XCommand -> FRequest
XCmd (Size -> XCommand
moveWindow (Size -> Size -> Size
psub Size
p (Size -> Size
offset Size
size)))] [Message FRequest b]
-> [Message FRequest b] -> [Message FRequest b]
forall a. [a] -> [a] -> [a]
++
if Bool -> Bool
not Bool
mapped then [FRequest -> Message FRequest b
forall a b. a -> Message a b
Low (FRequest -> Message FRequest b) -> FRequest -> Message FRequest b
forall a b. (a -> b) -> a -> b
$ XCommand -> FRequest
XCmd XCommand
MapRaised] else [])
High Maybe Size
Nothing ->
((Bool
False,Size
size),if Bool
mapped then [FRequest -> Message FRequest b
forall a b. a -> Message a b
Low (FRequest -> Message FRequest b) -> FRequest -> Message FRequest b
forall a b. (a -> b) -> a -> b
$ XCommand -> FRequest
XCmd XCommand
UnmapWindow] else [])
Low (LEvt (LayoutSize Size
size')) ->
((Bool
mapped,Size
size'), [])
KEvent (Maybe Size)
_ -> ((Bool, Size)
s, [])