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
= 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 (forall {a} {b} {c} {d}.
Sizing
-> [FRequest] -> K a b -> F c d -> F (Either a c) (Either b d)
unmappedGroupF Sizing
Dynamic)
= 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 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}) ->
[forall a b. b -> Message a b
High (a
tag, LayoutResponse -> FResponse
LEvt forall a b. (a -> b) -> a -> b
$ Size -> LayoutResponse
LayoutSize Size
size)]
LayoutMessage
_ -> []
FRequest
cmd' -> [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) = [forall a b. b -> Either a b
Right b
x, forall a b. a -> Either a b
Left (forall a b. a -> Either a b
Left (forall a. a -> Maybe a
Just Size
p))]
distr PopupMsg b
Popdown = [forall a b. a -> Either a b
Left (forall a b. a -> Either a b
Left forall a. Maybe a
Nothing)]
startcmds :: [FRequest]
startcmds = [XCommand -> FRequest
XCmd forall a b. (a -> b) -> a -> b
$ [WindowAttributes] -> XCommand
ChangeWindowAttributes [WindowAttributes]
wattrs]
in (forall {a1} {b}. SP (Either a1 b) b
filterRightSP forall a b e. SP a b -> F e a -> F e b
>^^=<
forall a b c.
SP TCommand (FCommand a) -> SP (FEvent a) TEvent -> F b c -> F b c
loopLow (forall {t} {b}. (t -> [b]) -> SP t b
concmapSP forall {a}. (a, FRequest) -> [Message (a, FRequest) (a, FResponse)]
post)
(forall {t} {b}. (t -> [b]) -> SP t b
concmapSP 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 (forall a b c d. K a b -> K c d -> K (Either a c) (Either b d)
compK (forall {ho}. (Size -> Size) -> K (Maybe Size) ho
placeK Size -> Size
offset) K c d
k) t
f)) forall c d e. F c d -> SP e c -> F e d
>=^^<
forall {t} {b}. (t -> [b]) -> SP t b
concatMapSP forall {b} {b}. PopupMsg b -> [Either (Either (Maybe Size) b) b]
distr
placeK :: (Size -> Size) -> K (Maybe Size) ho
placeK Size -> Size
offset = forall {t} {hi} {ho}.
(t -> KEvent hi -> (t, [KCommand ho])) -> t -> K hi ho
mapstateK forall {b}.
(Bool, Size)
-> Message FResponse (Maybe Size)
-> ((Bool, Size), [Message FRequest b])
sizeT (Bool
False,Int -> Int -> Size
pP Int
0 Int
0)
where
sizeT :: (Bool, Size)
-> Message FResponse (Maybe Size)
-> ((Bool, Size), [Message FRequest b])
sizeT s :: (Bool, Size)
s@(Bool
mapped,Size
size) Message FResponse (Maybe Size)
msg =
case Message FResponse (Maybe Size)
msg of
High (Just Size
p) ->
((Bool
True,Size
size),
[forall a b. a -> Message a b
Low forall a b. (a -> b) -> a -> b
$ XCommand -> FRequest
XCmd (Size -> XCommand
moveWindow (Size -> Size -> Size
psub Size
p (Size -> Size
offset Size
size)))] forall a. [a] -> [a] -> [a]
++
if Bool -> Bool
not Bool
mapped then [forall a b. a -> Message a b
Low 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 [forall a b. a -> Message a b
Low forall a b. (a -> b) -> a -> b
$ XCommand -> FRequest
XCmd XCommand
UnmapWindow] else [])
Low (LEvt (LayoutSize Size
size')) ->
((Bool
mapped,Size
size'), [])
Message FResponse (Maybe Size)
_ -> ((Bool, Size)
s, [])