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 =
         --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 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"