module PosPopupShellF(posPopupShellF) where
import Command
import Shells(unmappedShellF)
import Fudget
import FRequest
import Geometry(origin, pP, psub)
import Loops(loopCompThroughRightF)
import NullF
import QueryPointer
String
title [WindowAttributes]
wattrs F c a
f =
forall a b c d.
F (Either (Either a b) c) (Either (Either c d) a) -> F b d
loopCompThroughRightF (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]
startcmds forall {b} {b}. K (Either b (b, Maybe Point)) (Either b (b, b))
popupK F c a
f)
where
startcmds :: [FRequest]
startcmds =
[XCommand -> FRequest
XCmd forall a b. (a -> b) -> a -> b
$ String -> XCommand
StoreName String
title,
XCommand -> FRequest
XCmd forall a b. (a -> b) -> a -> b
$ Point -> XCommand
SetNormalHints Point
origin,
XCommand -> FRequest
XCmd forall a b. (a -> b) -> a -> b
$ [WindowAttributes] -> XCommand
ChangeWindowAttributes [WindowAttributes]
wattrs]
= forall {b} {b}.
(Bool, b) -> K (Either b (b, Maybe Point)) (Either b (b, b))
kf (forall a. HasCallStack => String -> a
error String
"premature output from fudget inside posPopupShellF")
where
pickPos :: Maybe Point -> (Point -> K b c) -> K b c
pickPos Maybe Point
p Point -> K b c
cont =
case Maybe Point
p of
Just Point
pos -> Point -> K b c
cont Point
pos
Maybe Point
Nothing -> forall {b} {c}. Cont (K b c) (Bool, Point, Point, ModState)
queryPointerK (\(Bool
_, Point
r, Point
_, ModState
_) -> Point -> K b c
cont (Point -> Point -> Point
psub Point
r (Int -> Int -> Point
pP Int
5 Int
5)))
kf :: (Bool, b) -> K (Either b (b, Maybe Point)) (Either b (b, b))
kf s :: (Bool, b)
s@(Bool
mapped,b
trig) =
forall {hi} {ho}. Cont (K hi ho) (KEvent hi)
getK forall a b. (a -> b) -> a -> b
$ \KEvent (Either b (b, Maybe Point))
msg ->
case KEvent (Either b (b, Maybe Point))
msg of
High (Right (b
trig', Maybe Point
optpos)) ->
forall {b} {c}. Maybe Point -> (Point -> K b c) -> K b c
pickPos Maybe Point
optpos forall a b. (a -> b) -> a -> b
$ \Point
pos ->
forall {b} {a}. [KCommand b] -> K a b -> K a b
putsK ([forall a b. a -> Message a b
Low forall a b. (a -> b) -> a -> b
$ XCommand -> FRequest
XCmd forall a b. (a -> b) -> a -> b
$ Point -> XCommand
moveWindow Point
pos,
forall a b. b -> Message a b
High (forall a b. a -> Either a b
Left b
trig')] 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 []) forall a b. (a -> b) -> a -> b
$
(Bool, b) -> K (Either b (b, Maybe Point)) (Either b (b, b))
kf (Bool
True,b
trig')
High (Left b
y) ->
forall {b} {a}. [KCommand b] -> K a b -> K a b
putsK ((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 []) forall a. [a] -> [a] -> [a]
++
[forall a b. b -> Message a b
High (forall a b. b -> Either a b
Right (b
trig, b
y))]) forall a b. (a -> b) -> a -> b
$
(Bool, b) -> K (Either b (b, Maybe Point)) (Either b (b, b))
kf (Bool
False,b
trig)
KEvent (Either b (b, Maybe Point))
_ -> (Bool, b) -> K (Either b (b, Maybe Point)) (Either b (b, b))
kf (Bool, b)
s