module HelpBubbleF(helpBubbleF) where
import AllFudgets
data BubbleState = Idle | Armed | Up
helpBubbleF :: g -> F c d -> F c d
helpBubbleF g
help F c d
fud =
if Bool
useBubbles
then F (Either
(Either Tick Any)
(Either (Either (Maybe (Int, Int)) (PopupMsg ())) c))
(Either
(Either (Maybe (Int, Int)) (PopupMsg ()))
(Either (Either Tick Any) d))
-> F c d
forall a b c d.
F (Either a (Either b c)) (Either b (Either a d)) -> F c d
loopCompThroughLeftF (F (Either
(Either Tick Any)
(Either (Either (Maybe (Int, Int)) (PopupMsg ())) c))
(Either
(Either (Maybe (Int, Int)) (PopupMsg ()))
(Either (Either Tick Any) d))
-> F c d)
-> F (Either
(Either Tick Any)
(Either (Either (Maybe (Int, Int)) (PopupMsg ())) c))
(Either
(Either (Maybe (Int, Int)) (PopupMsg ()))
(Either (Either Tick Any) d))
-> F c d
forall a b. (a -> b) -> a -> b
$
[FRequest]
-> K (Either Tick Any) (Either (Maybe (Int, Int)) (PopupMsg ()))
-> F (Either (Either (Maybe (Int, Int)) (PopupMsg ())) c)
(Either (Either Tick Any) d)
-> F (Either
(Either Tick Any)
(Either (Either (Maybe (Int, Int)) (PopupMsg ())) c))
(Either
(Either (Maybe (Int, Int)) (PopupMsg ()))
(Either (Either Tick Any) d))
forall a b c d.
[FRequest] -> K a b -> F c d -> F (Either a c) (Either b d)
groupF [FRequest]
startcmds K (Either Tick Any) (Either (Maybe (Int, Int)) (PopupMsg ()))
forall p.
K (Either Tick p) (Either (Maybe (Int, Int)) (PopupMsg ()))
ctrlK0 ((F (Maybe (Int, Int)) Tick
timerFF (Maybe (Int, Int)) Tick
-> F (PopupMsg ()) Any
-> F (Either (Maybe (Int, Int)) (PopupMsg ())) (Either Tick Any)
forall a b c d. F a b -> F c d -> F (Either a c) (Either b d)
>+<F (PopupMsg ()) Any
forall b2 d2. F (PopupMsg b2) d2
bubbleF) F (Either (Maybe (Int, Int)) (PopupMsg ())) (Either Tick Any)
-> F c d
-> F (Either (Either (Maybe (Int, Int)) (PopupMsg ())) c)
(Either (Either Tick Any) d)
forall a b c d. F a b -> F c d -> F (Either a c) (Either b d)
>+< F c d
fud)
else F c d
fud
where
bubbleF :: F (PopupMsg b2) d2
bubbleF = F b2 d2 -> F (PopupMsg b2) d2
forall b2 d2. F b2 d2 -> F (PopupMsg b2) d2
bubbleRootPopupF (Customiser (DisplayF g) -> g -> F b2 d2
forall g a b. Graphic g => Customiser (DisplayF g) -> g -> F a b
labelF' Customiser (DisplayF g)
lblpm g
help)
lblpm :: Customiser (DisplayF g)
lblpm = [Char] -> Customiser (DisplayF g)
forall xxx a.
(HasBgColorSpec xxx, Show a, ColorGen a) =>
a -> Customiser xxx
setBgColor [Char]
"white" Customiser (DisplayF g)
-> Customiser (DisplayF g) -> Customiser (DisplayF g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Customiser (DisplayF g)
forall xxx a.
(HasFontSpec xxx, Show a, FontGen a) =>
a -> Customiser xxx
setFont [Char]
helpFont
eventmask :: [EventMask]
eventmask = [EventMask
EnterWindowMask,EventMask
LeaveWindowMask]
startcmds :: [FRequest]
startcmds = [XCommand -> FRequest
XCmd (XCommand -> FRequest) -> XCommand -> FRequest
forall a b. (a -> b) -> a -> b
$ [WindowAttributes] -> XCommand
ChangeWindowAttributes [[EventMask] -> WindowAttributes
CWEventMask [EventMask]
eventmask],
XCommand -> FRequest
XCmd (XCommand -> FRequest) -> XCommand -> FRequest
forall a b. (a -> b) -> a -> b
$ [WindowChanges] -> XCommand
ConfigureWindow [Int -> WindowChanges
CWBorderWidth Int
0]]
ctrlK0 :: K (Either Tick p) (Either (Maybe (Int, Int)) (PopupMsg ()))
ctrlK0 = Point
-> Point
-> BubbleState
-> K (Either Tick p) (Either (Maybe (Int, Int)) (PopupMsg ()))
forall a b p.
(Num a, Num b) =>
Point
-> Point
-> BubbleState
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
ctrlK Point
0 Point
0 BubbleState
Idle
toTimer :: a -> Message a (Either a b)
toTimer = Either a b -> Message a (Either a b)
forall a b. b -> Message a b
High (Either a b -> Message a (Either a b))
-> (a -> Either a b) -> a -> Message a (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a b
forall a b. a -> Either a b
Left
toBubble :: b -> Message a (Either a b)
toBubble = Either a b -> Message a (Either a b)
forall a b. b -> Message a b
High (Either a b -> Message a (Either a b))
-> (b -> Either a b) -> b -> Message a (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either a b
forall a b. b -> Either a b
Right
ctrlK :: Point
-> Point
-> BubbleState
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
ctrlK Point
size Point
pos BubbleState
bubbleState =
Cont
(K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ())))
(KEvent (Either Tick p))
forall hi ho. Cont (K hi ho) (KEvent hi)
getK Cont
(K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ())))
(KEvent (Either Tick p))
-> Cont
(K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ())))
(KEvent (Either Tick p))
forall a b. (a -> b) -> a -> b
$ (FResponse
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ())))
-> (Either Tick p
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ())))
-> KEvent (Either Tick p)
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
forall t1 p t2. (t1 -> p) -> (t2 -> p) -> Message t1 t2 -> p
message FResponse
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
event ((Tick -> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ())))
-> (p -> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ())))
-> Either Tick p
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Tick -> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
fromTimer p -> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
forall p.
p -> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
fromBubble)
where
same :: K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
same = Point
-> Point
-> BubbleState
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
ctrlK Point
size Point
pos BubbleState
bubbleState
idle :: K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
idle = Point
-> Point
-> BubbleState
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
ctrlK Point
size Point
pos BubbleState
Idle
newSize :: Point -> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
newSize Point
size' = Point
-> Point
-> BubbleState
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
ctrlK Point
size' Point
pos BubbleState
bubbleState
timerOff :: BubbleState
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
timerOff BubbleState
s = KCommand (Either (Maybe (a, b)) (PopupMsg ()))
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
forall ho hi. KCommand ho -> K hi ho -> K hi ho
putK (Maybe (a, b) -> KCommand (Either (Maybe (a, b)) (PopupMsg ()))
forall a a b. a -> Message a (Either a b)
toTimer Maybe (a, b)
forall a. Maybe a
Nothing) (K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ())))
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
forall a b. (a -> b) -> a -> b
$ Point
-> Point
-> BubbleState
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
ctrlK Point
size Point
pos BubbleState
s
timerOn :: Point -> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
timerOn Point
pos' = KCommand (Either (Maybe (a, b)) (PopupMsg ()))
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
forall ho hi. KCommand ho -> K hi ho -> K hi ho
putK (Maybe (a, b) -> KCommand (Either (Maybe (a, b)) (PopupMsg ()))
forall a a b. a -> Message a (Either a b)
toTimer ((a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
0,b
500))) (K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ())))
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
forall a b. (a -> b) -> a -> b
$ Point
-> Point
-> BubbleState
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
ctrlK Point
size Point
pos' BubbleState
Armed
fromBubble :: p -> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
fromBubble p
_ = K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
same
fromTimer :: Tick -> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
fromTimer Tick
Tick =
case BubbleState
bubbleState of
BubbleState
Armed ->
KCommand (Either (Maybe (a, b)) (PopupMsg ()))
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
forall ho hi. KCommand ho -> K hi ho -> K hi ho
putK (PopupMsg () -> KCommand (Either (Maybe (a, b)) (PopupMsg ()))
forall b a a. b -> Message a (Either a b)
toBubble (Point -> () -> PopupMsg ()
forall a. Point -> a -> PopupMsg a
Popup (Point
posPoint -> Point -> Point
forall a. Num a => a -> a -> a
+Point
offset) ())) (K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ())))
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
forall a b. (a -> b) -> a -> b
$
BubbleState
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
timerOff BubbleState
Up
where offset :: Point
offset = Int -> Int -> Point
pP (Point -> Int
xcoord Point
size Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Int
3
BubbleState
_ -> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
same
event :: FResponse
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
event FResponse
e =
case FResponse
e of
XEvt EnterNotify { pos :: XEvent -> Point
pos=Point
pos,rootPos :: XEvent -> Point
rootPos=Point
rootPos } -> Point -> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
timerOn (Point
rootPosPoint -> Point -> Point
forall a. Num a => a -> a -> a
-Point
pos)
XEvt LeaveNotify { } ->
case BubbleState
bubbleState of
BubbleState
Idle -> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
same
BubbleState
Armed -> BubbleState
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
timerOff BubbleState
Idle
BubbleState
Up -> KCommand (Either (Maybe (a, b)) (PopupMsg ()))
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
forall ho hi. KCommand ho -> K hi ho -> K hi ho
putK (PopupMsg () -> KCommand (Either (Maybe (a, b)) (PopupMsg ()))
forall b a a. b -> Message a (Either a b)
toBubble PopupMsg ()
forall a. PopupMsg a
Popdown) (K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ())))
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
-> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
forall a b. (a -> b) -> a -> b
$ K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
idle
LEvt (LayoutSize Point
size') -> Point -> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
newSize Point
size'
FResponse
_ -> K (Either Tick p) (Either (Maybe (a, b)) (PopupMsg ()))
same
useBubbles :: Bool
useBubbles = [Char] -> Bool -> Bool
argFlag [Char]
"helpbubbles" Bool
True
helpFont :: [Char]
helpFont = [Char] -> [Char] -> [Char]
argKey [Char]
"helpfont" [Char]
"-*-new century schoolbook-medium-r-*-*-12-*-*-*-*-*-iso8859-1"