module HelpBubbleF(helpBubbleF) where
import AllFudgets

data BubbleState = Idle | Armed | Up

helpBubbleF :: a1 -> F c d -> F c d
helpBubbleF a1
help F c d
fud =
    if Bool
useBubbles
    then forall a b c d.
F (Either a (Either b c)) (Either b (Either a d)) -> F c d
loopCompThroughLeftF forall a b. (a -> b) -> a -> b
$
         forall {a} {b} {c} {d}.
[FRequest] -> K a b -> F c d -> F (Either a c) (Either b d)
groupF [FRequest]
startcmds forall {b}.
K (Either Tick b) (Either (Maybe (Int, Int)) (PopupMsg ()))
ctrlK0 ((F (Maybe (Int, Int)) Tick
timerFforall {a} {b} {c} {d}.
F a b -> F c d -> F (Either a c) (Either b d)
>+<forall {b2} {d2}. F (PopupMsg b2) d2
bubbleF) 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 = forall {b2} {d2}. F b2 d2 -> F (PopupMsg b2) d2
bubbleRootPopupF (forall {a1} {a2} {b}.
Graphic a1 =>
Customiser (DisplayF a1) -> a1 -> F a2 b
labelF' DisplayF a1 -> DisplayF a1
lblpm a1
help)
   lblpm :: DisplayF a1 -> DisplayF a1
lblpm = forall {xxx} {p}.
(HasBgColorSpec xxx, Show p, ColorGen p) =>
p -> Customiser xxx
setBgColor String
"white" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {xxx} {a}.
(HasFontSpec xxx, Show a, FontGen a) =>
a -> Customiser xxx
setFont String
helpFont
   eventmask :: [EventMask]
eventmask = [EventMask
EnterWindowMask,EventMask
LeaveWindowMask]
   startcmds :: [FRequest]
startcmds = [XCommand -> FRequest
XCmd forall a b. (a -> b) -> a -> b
$ [WindowAttributes] -> XCommand
ChangeWindowAttributes [[EventMask] -> WindowAttributes
CWEventMask [EventMask]
eventmask],
                XCommand -> FRequest
XCmd forall a b. (a -> b) -> a -> b
$ [WindowChanges] -> XCommand
ConfigureWindow [Int -> WindowChanges
CWBorderWidth Int
0]]

   ctrlK0 :: K (Either Tick b) (Either (Maybe (Int, Int)) (PopupMsg ()))
ctrlK0 = forall {a} {b} {b}.
(Num a, Num b) =>
Point
-> Point
-> BubbleState
-> K (Either Tick b) (Either (Maybe (a, b)) (PopupMsg ()))
ctrlK Point
0 Point
0 BubbleState
Idle

   toTimer :: a -> Message a (Either a b)
toTimer = forall a b. b -> Message a b
High forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left
   toBubble :: a -> Message a (Either a a)
toBubble = forall a b. b -> Message a b
High forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right

   ctrlK :: Point
-> Point
-> BubbleState
-> K (Either Tick b) (Either (Maybe (a, b)) (PopupMsg ()))
ctrlK Point
size Point
pos BubbleState
bubbleState =
      forall {hi} {ho}. Cont (K hi ho) (KEvent hi)
getK forall a b. (a -> b) -> a -> b
$ forall {t1} {t2} {t3}.
(t1 -> t2) -> (t3 -> t2) -> Message t1 t3 -> t2
message FResponse
-> K (Either Tick b) (Either (Maybe (a, b)) (PopupMsg ()))
event (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Tick -> K (Either Tick b) (Either (Maybe (a, b)) (PopupMsg ()))
fromTimer forall {p}.
p -> K (Either Tick b) (Either (Maybe (a, b)) (PopupMsg ()))
fromBubble)
     where
       same :: K (Either Tick b) (Either (Maybe (a, b)) (PopupMsg ()))
same = Point
-> Point
-> BubbleState
-> K (Either Tick b) (Either (Maybe (a, b)) (PopupMsg ()))
ctrlK Point
size Point
pos BubbleState
bubbleState
       idle :: K (Either Tick b) (Either (Maybe (a, b)) (PopupMsg ()))
idle = Point
-> Point
-> BubbleState
-> K (Either Tick b) (Either (Maybe (a, b)) (PopupMsg ()))
ctrlK Point
size Point
pos BubbleState
Idle
       newSize :: Point -> K (Either Tick b) (Either (Maybe (a, b)) (PopupMsg ()))
newSize Point
size' = Point
-> Point
-> BubbleState
-> K (Either Tick b) (Either (Maybe (a, b)) (PopupMsg ()))
ctrlK Point
size' Point
pos BubbleState
bubbleState
       timerOff :: BubbleState
-> K (Either Tick b) (Either (Maybe (a, b)) (PopupMsg ()))
timerOff BubbleState
s = forall {ho} {hi}. KCommand ho -> K hi ho -> K hi ho
putK (forall {a} {a} {b}. a -> Message a (Either a b)
toTimer forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$ Point
-> Point
-> BubbleState
-> K (Either Tick b) (Either (Maybe (a, b)) (PopupMsg ()))
ctrlK Point
size Point
pos BubbleState
s
       timerOn :: Point -> K (Either Tick b) (Either (Maybe (a, b)) (PopupMsg ()))
timerOn Point
pos' = forall {ho} {hi}. KCommand ho -> K hi ho -> K hi ho
putK (forall {a} {a} {b}. a -> Message a (Either a b)
toTimer (forall a. a -> Maybe a
Just (a
0,b
500))) forall a b. (a -> b) -> a -> b
$ Point
-> Point
-> BubbleState
-> K (Either Tick b) (Either (Maybe (a, b)) (PopupMsg ()))
ctrlK Point
size Point
pos' BubbleState
Armed

       fromBubble :: p -> K (Either Tick b) (Either (Maybe (a, b)) (PopupMsg ()))
fromBubble p
_ = K (Either Tick b) (Either (Maybe (a, b)) (PopupMsg ()))
same

       fromTimer :: Tick -> K (Either Tick b) (Either (Maybe (a, b)) (PopupMsg ()))
fromTimer Tick
Tick =
         case BubbleState
bubbleState of
	   BubbleState
Armed ->
	       forall {ho} {hi}. KCommand ho -> K hi ho -> K hi ho
putK (forall {a} {a} {a}. a -> Message a (Either a a)
toBubble (forall a. Point -> a -> PopupMsg a
Popup (Point
posforall a. Num a => a -> a -> a
+Point
offset) ())) forall a b. (a -> b) -> a -> b
$
	       BubbleState
-> K (Either Tick b) (Either (Maybe (a, b)) (PopupMsg ()))
timerOff BubbleState
Up
	     where offset :: Point
offset = Int -> Int -> Point
pP (Point -> Int
xcoord Point
size forall a. Integral a => a -> a -> a
`div` Int
2) Int
3
	   BubbleState
_ -> K (Either Tick b) (Either (Maybe (a, b)) (PopupMsg ()))
same
       event :: FResponse
-> K (Either Tick b) (Either (Maybe (a, b)) (PopupMsg ()))
event FResponse
e =
         --echoK (show e) $
         case FResponse
e of
	   XEvt EnterNotify { pos :: XEvent -> Point
pos=Point
pos,rootPos :: XEvent -> Point
rootPos=Point
rootPos } -> Point -> K (Either Tick b) (Either (Maybe (a, b)) (PopupMsg ()))
timerOn (Point
rootPosforall a. Num a => a -> a -> a
-Point
pos)

	   XEvt LeaveNotify { } ->
	     case BubbleState
bubbleState of
	       BubbleState
Idle -> K (Either Tick b) (Either (Maybe (a, b)) (PopupMsg ()))
same
	       BubbleState
Armed -> BubbleState
-> K (Either Tick b) (Either (Maybe (a, b)) (PopupMsg ()))
timerOff BubbleState
Idle
	       BubbleState
Up -> forall {ho} {hi}. KCommand ho -> K hi ho -> K hi ho
putK (forall {a} {a} {a}. a -> Message a (Either a a)
toBubble forall a. PopupMsg a
Popdown) forall a b. (a -> b) -> a -> b
$ K (Either Tick b) (Either (Maybe (a, b)) (PopupMsg ()))
idle

	   LEvt (LayoutSize Point
size') -> Point -> K (Either Tick b) (Either (Maybe (a, b)) (PopupMsg ()))
newSize Point
size'
	   FResponse
_ -> K (Either Tick b) (Either (Maybe (a, b)) (PopupMsg ()))
same

useBubbles :: Bool
useBubbles = String -> Bool -> Bool
argFlag String
"helpbubbles" Bool
True
helpFont :: String
helpFont = String -> String -> String
argKey String
"helpfont" String
"-*-new century schoolbook-medium-r-*-*-12-*-*-*-*-*-iso8859-1"