module PopupGroupF(popupGroupF,rootPopupF) where
import Command
import CompOps((>=^^<), (>^^=<))
--import Direction
import Dlayout(unmappedGroupF)
import Sizing(Sizing(..))
import Shells(unmappedShellF)
--import Event
import Fudget
import FRequest
import Geometry(psub,pP)
import LayoutRequest
import LoopLow
--import Message(Message(..))
import ParK
--import Path(Path(..))
import Popupmsg
--import Spops
import MapstateK
import SpEither(filterRightSP)
--import SerCompF(concatMapF)
import Spops
--import Xtypes

popupGroupF :: (Size -> Size, [WindowAttributes], K b d)
-> F b d -> F (PopupMsg b) d
popupGroupF = 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)
rootPopupF :: (Size -> Size, [WindowAttributes], K b d)
-> F b d -> F (PopupMsg b) d
rootPopupF  = 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

popupF :: ([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) 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
--		  Layout size fh' fv -> [High (tag, LEvt $ LayoutPlace (Rect origin size))]
		  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)]
		    -- treated specially in windowKF.
		  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
_)) -> [] -- shouldn't happen?
              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, [])