module MenuF(simpleMenuF, menuAltsF, menuF, oldMenuF, buttonMenuF, buttonMenuF', grabberF, MenuState,menuDown,EqSnd(..),fstEqSnd,sndEqSnd,toEqSnd) where
import Command
import Event
import Geometry(pP,Point(..),Size,inRect,Rect(..))
import Message(message )--Message(..),
import Fudget
import FRequest
import FudgetIO
import StreamProcIO
import Xcommand
import NullF
import CompOps((>^=<), (>=^<), (>=^^<), (>^^=<),(>+<))
import Dlayout(groupF)
import SerCompF(bypassF)--,idRightF
import Loops(loopCompThroughRightF)
import LayoutDir(LayoutDir(..))
import LayoutF(listLF)
import LayoutRequest(LayoutResponse(..))
import Placers
import Spacers() -- synonym Distance, for hbc
import MenuButtonF
import MenuPopupF
import Spops(nullSP)
import MapstateK
import SpEither(filterRightSP)
import EitherUtils(mapEither)--stripEither
import Xtypes
import Defaults(menuFont)
import CmdLineEnv(argFlag)
import Graphic
import Data.Array
--import DialogueIO hiding (IOError)
import ShowCommandF(showCommandF)
import Debug.Trace(trace)

data EqSnd a b = EqSnd a b

instance (Eq b) => Eq (EqSnd a b) where
    EqSnd a
a1 b
b1 == :: EqSnd a b -> EqSnd a b -> Bool
== EqSnd a
a2 b
b2  =  b
b1 b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
b2

fstEqSnd :: EqSnd a b -> a
fstEqSnd (EqSnd a
a b
b) = a
a
sndEqSnd :: EqSnd a b -> b
sndEqSnd (EqSnd a
a b
b) = b
b
toEqSnd :: [(a, b)] -> [EqSnd a b]
toEqSnd [(a, b)]
x = ((a, b) -> EqSnd a b) -> [(a, b)] -> [EqSnd a b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b -> EqSnd a b) -> (a, b) -> EqSnd a b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> EqSnd a b
forall a b. a -> b -> EqSnd a b
EqSnd) [(a, b)]
x

menuF :: (Graphic mlbl,Graphic albl) => mlbl -> [(alt,albl)] -> F alt alt
menuF :: mlbl -> [(alt, albl)] -> F alt alt
menuF mlbl
name [(alt, albl)]
altlbls =
    F alt alt -> F alt alt
forall a. F a a -> F a a
bypassF ((Array Int alt
naltsArray Int alt -> Int -> alt
forall i e. Ix i => Array i e -> i -> e
!) (Int -> alt) -> (EqSnd albl Int -> Int) -> EqSnd albl Int -> alt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EqSnd albl Int -> Int
forall a b. EqSnd a b -> b
sndEqSnd (EqSnd albl Int -> alt) -> F mlbl (EqSnd albl Int) -> F mlbl alt
forall a b e. (a -> b) -> F e a -> F e b
>^=< 
      FontName
-> mlbl
-> [EqSnd albl Int]
-> (EqSnd albl Int -> albl)
-> F mlbl (EqSnd albl Int)
forall b c a.
(Eq b, Graphic c, Graphic a) =>
FontName -> a -> [b] -> (b -> c) -> F a b
simpleMenuF FontName
menuFont mlbl
name [EqSnd albl Int]
lblns EqSnd albl Int -> albl
forall a b. EqSnd a b -> a
fstEqSnd F mlbl alt -> SP alt mlbl -> F alt alt
forall c d e. F c d -> SP e c -> F e d
>=^^< SP alt mlbl
forall a b. SP a b
nullSP)
  where
    ([alt]
alts,[albl]
lbls) = [(alt, albl)] -> ([alt], [albl])
forall a b. [(a, b)] -> ([a], [b])
unzip [(alt, albl)]
altlbls
    lblns :: [EqSnd albl Int]
lblns = (albl -> Int -> EqSnd albl Int)
-> [albl] -> [Int] -> [EqSnd albl Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith albl -> Int -> EqSnd albl Int
forall a b. a -> b -> EqSnd a b
EqSnd [albl]
lbls [Int]
ixs
    n :: Int
n = [alt] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [alt]
alts
    ixs :: [Int]
ixs =  [Int
1 .. Int
n]
    nalts :: Array Int alt
nalts = (Int, Int) -> [(Int, alt)] -> Array Int alt
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (Int
1,Int
n) ([Int] -> [alt] -> [(Int, alt)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
ixs [alt]
alts)


simpleMenuF :: FontName -> a -> [b] -> (b -> c) -> F a b
simpleMenuF FontName
fname a
name = FontName -> a -> [(b, [(ModState, FontName)])] -> (b -> c) -> F a b
forall c b a.
(Graphic c, Eq b, Graphic a) =>
FontName -> a -> [(b, [(ModState, FontName)])] -> (b -> c) -> F a b
oldMenuF FontName
fname a
name ([(b, [(ModState, FontName)])] -> (b -> c) -> F a b)
-> ([b] -> [(b, [(ModState, FontName)])])
-> [b]
-> (b -> c)
-> F a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> (b, [(ModState, FontName)]))
-> [b] -> [(b, [(ModState, FontName)])]
forall a b. (a -> b) -> [a] -> [b]
map (\b
x -> (b
x,[]))

oldMenuF :: (Graphic c, Eq b, Graphic a) => FontName -> a -> [(b, [(ModState, KeySym)])] -> (b -> c) -> F a b 
oldMenuF :: FontName -> a -> [(b, [(ModState, FontName)])] -> (b -> c) -> F a b
oldMenuF FontName
fname a
name [(b, [(ModState, FontName)])]
alts b -> c
show_alt =
    [(a, [(ModState, FontName)])]
-> F (Either MenuState a) (Either MenuState b) -> F a b
forall a a d.
[(a, [(ModState, FontName)])]
-> F (Either a a) (Either MenuState d) -> F a d
grabberF [] (LayoutDir
-> FontName
-> a
-> [(b, [(ModState, FontName)])]
-> F (Either MenuState (b, c)) b
-> F (Either MenuState (Either a (b, c))) (Either MenuState b)
forall lbl a b.
Graphic lbl =>
LayoutDir
-> FontName
-> lbl
-> [(a, [(ModState, FontName)])]
-> F (Either MenuState b) a
-> F (Either MenuState (Either lbl b)) (Either MenuState a)
buttonMenuF LayoutDir
Horizontal FontName
fname a
name [(b, [(ModState, FontName)])]
alts F (Either MenuState (b, c)) b
forall a1. F (Either a1 (b, c)) b
menuAltsF (Either MenuState (Either a (b, c))) (Either MenuState b)
-> (Either MenuState a -> Either MenuState (Either a (b, c)))
-> F (Either MenuState a) (Either MenuState b)
forall c d e. F c d -> (e -> c) -> F e d
>=^<(MenuState -> MenuState)
-> (a -> Either a (b, c))
-> Either MenuState a
-> Either MenuState (Either a (b, c))
forall t1 a t2 b.
(t1 -> a) -> (t2 -> b) -> Either t1 t2 -> Either a b
mapEither MenuState -> MenuState
forall a. a -> a
id a -> Either a (b, c)
forall a b. a -> Either a b
Left)
  where
    menuAlts :: F (Either a1 (b, c)) b
menuAlts = FontName -> [b] -> (b -> c) -> F (b, c) b
forall b b.
(Eq b, Graphic b) =>
FontName -> [b] -> (b -> b) -> F (b, b) b
menuAltsF' FontName
fname (((b, [(ModState, FontName)]) -> b)
-> [(b, [(ModState, FontName)])] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (b, [(ModState, FontName)]) -> b
forall a b. (a, b) -> a
fst [(b, [(ModState, FontName)])]
alts) b -> c
show_alt F (b, c) b
-> SP (Either a1 (b, c)) (b, c) -> F (Either a1 (b, c)) b
forall c d e. F c d -> SP e c -> F e d
>=^^< SP (Either a1 (b, c)) (b, c)
forall a1 b. SP (Either a1 b) b
filterRightSP

menuAltsF' :: FontName -> [b] -> (b -> b) -> F (b, b) b
menuAltsF' FontName
fname [b]
alts b -> b
show_alt =
    (b, Click) -> b
forall a b. (a, b) -> a
fst ((b, Click) -> b) -> F (b, b) (b, Click) -> F (b, b) b
forall a b e. (a -> b) -> F e a -> F e b
>^=< Placer -> [(b, F b Click)] -> F (b, b) (b, Click)
forall a b c. Eq a => Placer -> [(a, F b c)] -> F (a, b) (a, c)
listLF (Int -> Placer
verticalP' Int
0) ((b -> (b, F b Click)) -> [b] -> [(b, F b Click)]
forall a b. (a -> b) -> [a] -> [b]
map b -> (b, F b Click)
altButton [b]
alts)
  where
    altButton :: b -> (b, F b Click)
altButton (b
alt{-, keys-}) = (b
alt, FontName -> b -> F b Click
forall lbl. Graphic lbl => FontName -> lbl -> F lbl Click
menuButtonF FontName
fname {-keys-} (b -> b
show_alt b
alt))

menuAltsF :: FontName -> [d] -> (d -> b) -> F PopupMenu d
menuAltsF FontName
fname [d]
alts d -> b
show_alt =
   F (d, b) d -> F (Either PopupMenu (d, b)) d
forall b d. F b d -> F (Either PopupMenu b) d
menuPopupF (FontName -> [d] -> (d -> b) -> F (d, b) d
forall b b.
(Eq b, Graphic b) =>
FontName -> [b] -> (b -> b) -> F (b, b) b
menuAltsF' FontName
fname [d]
alts d -> b
show_alt) F (Either PopupMenu (d, b)) d
-> (PopupMenu -> Either PopupMenu (d, b)) -> F PopupMenu d
forall c d e. F c d -> (e -> c) -> F e d
>=^< PopupMenu -> Either PopupMenu (d, b)
forall a b. a -> Either a b
Left

grabberF :: [(a, [(ModState, FontName)])]
-> F (Either a a) (Either MenuState d) -> F a d
grabberF [(a, [(ModState, FontName)])]
alts F (Either a a) (Either MenuState d)
mF = F (Either (Either (Either MenuState d) a) (Either a a))
  (Either (Either (Either a a) d) (Either MenuState d))
-> F a d
forall a b c d.
F (Either (Either a b) c) (Either (Either c d) a) -> F b d
loopCompThroughRightF ([FRequest]
-> K (Either (Either MenuState d) a) (Either (Either a a) d)
-> F (Either a a) (Either MenuState d)
-> F (Either (Either (Either MenuState d) a) (Either a a))
     (Either (Either (Either a a) d) (Either MenuState 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 (Either MenuState d) a) (Either (Either a a) d)
forall b a.
K (Either (Either MenuState b) a) (Either (Either a a) b)
grabK0 F (Either a a) (Either MenuState d)
mF)
  where
    startcmds :: [FRequest]
startcmds = (XCommand -> FRequest) -> [XCommand] -> [FRequest]
forall a b. (a -> b) -> [a] -> [b]
map XCommand -> FRequest
XCmd [XCommand]
transinit
    grabK0 :: K (Either (Either MenuState b) a) (Either (Either a a) b)
grabK0 = Bool -> K (Either (Either MenuState b) a) (Either (Either a a) b)
forall b a.
Bool -> K (Either (Either MenuState b) a) (Either (Either a a) b)
grabK Bool
False

    transinit :: [XCommand]
transinit =
        if [(ModState, FontName)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ModState, FontName)]
keys
	then []
        else  [(XEvent -> Maybe XEvent) -> [EventMask] -> XCommand
TranslateEvent XEvent -> Maybe XEvent
tobutton [EventMask
KeyPressMask, EventMask
KeyReleaseMask]]
      where
        keys :: [(ModState, FontName)]
keys = ((a, [(ModState, FontName)]) -> [(ModState, FontName)])
-> [(a, [(ModState, FontName)])] -> [(ModState, FontName)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (a, [(ModState, FontName)]) -> [(ModState, FontName)]
forall a b. (a, b) -> b
snd [(a, [(ModState, FontName)])]
alts
        tobutton :: XEvent -> Maybe XEvent
tobutton e :: XEvent
e@(KeyEvent {state :: XEvent -> ModState
state=ModState
s,keySym :: XEvent -> FontName
keySym=FontName
ks}) | (ModState
s, FontName
ks) (ModState, FontName) -> [(ModState, FontName)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(ModState, FontName)]
keys = XEvent -> Maybe XEvent
forall a. a -> Maybe a
Just XEvent
e
	tobutton XEvent
_ = Maybe XEvent
forall a. Maybe a
Nothing
    grabK :: Bool -> K (Either (Either MenuState b) a) (Either (Either a a) b)
grabK Bool
up = Cont
  (K (Either (Either MenuState b) a) (Either (Either a a) b))
  (KEvent (Either (Either MenuState b) a))
forall hi ho. Cont (K hi ho) (KEvent hi)
getK Cont
  (K (Either (Either MenuState b) a) (Either (Either a a) b))
  (KEvent (Either (Either MenuState b) a))
-> Cont
     (K (Either (Either MenuState b) a) (Either (Either a a) b))
     (KEvent (Either (Either MenuState b) a))
forall a b. (a -> b) -> a -> b
$ (FResponse
 -> K (Either (Either MenuState b) a) (Either (Either a a) b))
-> (Either (Either MenuState b) a
    -> K (Either (Either MenuState b) a) (Either (Either a a) b))
-> KEvent (Either (Either MenuState b) a)
-> K (Either (Either MenuState b) a) (Either (Either a a) b)
forall t1 p t2. (t1 -> p) -> (t2 -> p) -> Message t1 t2 -> p
message FResponse
-> K (Either (Either MenuState b) a) (Either (Either a a) b)
low Either (Either MenuState b) a
-> K (Either (Either MenuState b) a) (Either (Either a a) b)
high
      where
	keyalts :: [((ModState, FontName), a)]
keyalts = [((ModState, FontName)
k,a
a)|(a
a,[(ModState, FontName)]
ks)<-[(a, [(ModState, FontName)])]
alts,(ModState, FontName)
k<-[(ModState, FontName)]
ks]
	same :: K (Either (Either MenuState b) a) (Either (Either a a) b)
same = Bool -> K (Either (Either MenuState b) a) (Either (Either a a) b)
grabK Bool
up
	popdown :: K (Either (Either MenuState b) a) (Either (Either a a) b)
popdown = Bool -> K (Either (Either MenuState b) a) (Either (Either a a) b)
grabK Bool
False
	popup :: K (Either (Either MenuState b) a) (Either (Either a a) b)
popup = Bool -> K (Either (Either MenuState b) a) (Either (Either a a) b)
grabK Bool
True
	low :: FResponse
-> K (Either (Either MenuState b) a) (Either (Either a a) b)
low FResponse
event =
	  case FResponse
event of
	    XEvt (KeyEvent {state :: XEvent -> ModState
state=ModState
s,keySym :: XEvent -> FontName
keySym=FontName
ks,type' :: XEvent -> Pressed
type'=Pressed
Pressed}) ->
		[Either (Either a a) b]
-> K (Either (Either MenuState b) a) (Either (Either a a) b)
-> K (Either (Either MenuState b) a) (Either (Either a a) b)
forall (t :: * -> *) (sp :: * -> * -> *) o i.
(Foldable t, StreamProcIO sp) =>
t o -> sp i o -> sp i o
puts [Either a a -> Either (Either a a) b
forall a b. a -> Either a b
Left (a -> Either a a
forall a b. b -> Either a b
Right a
alt)|((ModState, FontName)
key,a
alt)<-[((ModState, FontName), a)]
keyalts,(ModState
s,FontName
ks)(ModState, FontName) -> (ModState, FontName) -> Bool
forall a. Eq a => a -> a -> Bool
==(ModState, FontName)
key] K (Either (Either MenuState b) a) (Either (Either a a) b)
same
	    FResponse
_ ->  K (Either (Either MenuState b) a) (Either (Either a a) b)
same
	high :: Either (Either MenuState b) a
-> K (Either (Either MenuState b) a) (Either (Either a a) b)
high = (Either MenuState b
 -> K (Either (Either MenuState b) a) (Either (Either a a) b))
-> (a -> K (Either (Either MenuState b) a) (Either (Either a a) b))
-> Either (Either MenuState b) a
-> K (Either (Either MenuState b) a) (Either (Either a a) b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Either MenuState b
-> K (Either (Either MenuState b) a) (Either (Either a a) b)
fromLoop a -> K (Either (Either MenuState b) a) (Either (Either a a) b)
fromOutside
	fromLoop :: Either MenuState b
-> K (Either (Either MenuState b) a) (Either (Either a a) b)
fromLoop = (MenuState
 -> K (Either (Either MenuState b) a) (Either (Either a a) b))
-> (b -> K (Either (Either MenuState b) a) (Either (Either a a) b))
-> Either MenuState b
-> K (Either (Either MenuState b) a) (Either (Either a a) b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either MenuState
-> K (Either (Either MenuState b) a) (Either (Either a a) b)
menuCoordination b -> K (Either (Either MenuState b) a) (Either (Either a a) b)
menuSelection
	fromOutside :: a -> K (Either (Either MenuState b) a) (Either (Either a a) b)
fromOutside a
x = Either (Either a a) b
-> K (Either (Either MenuState b) a) (Either (Either a a) b)
-> K (Either (Either MenuState b) a) (Either (Either a a) b)
forall (f :: * -> * -> *) ho hi.
FudgetIO f =>
ho -> f hi ho -> f hi ho
putHigh (Either a a -> Either (Either a a) b
forall a b. a -> Either a b
Left (a -> Either a a
forall a b. b -> Either a b
Right a
x)) K (Either (Either MenuState b) a) (Either (Either a a) b)
same
	menuSelection :: b -> K (Either (Either MenuState b) a) (Either (Either a a) b)
menuSelection b
x = Either (Either a a) b
-> K (Either (Either MenuState b) a) (Either (Either a a) b)
-> K (Either (Either MenuState b) a) (Either (Either a a) b)
forall (f :: * -> * -> *) ho hi.
FudgetIO f =>
ho -> f hi ho -> f hi ho
putHigh (b -> Either (Either a a) b
forall a b. b -> Either a b
Right b
x) K (Either (Either MenuState b) a) (Either (Either a a) b)
same
	menuCoordination :: MenuState
-> K (Either (Either MenuState b) a) (Either (Either a a) b)
menuCoordination MenuState
newState =
	  case (Bool
up,MenuState
newState) of
	    (Bool
False,MenuUp Bool
_) ->
	      --trace "grabberF: GrabEvents False" $
	      XCommand
-> K (Either (Either MenuState b) a) (Either (Either a a) b)
-> K (Either (Either MenuState b) a) (Either (Either a a) b)
forall i o. XCommand -> K i o -> K i o
xcommandK (Bool -> XCommand
GrabEvents Bool
False) K (Either (Either MenuState b) a) (Either (Either a a) b)
popup
	    (Bool
True,MenuState
MenuDown) ->
	      --trace "grabberF: UngrabEvents" $
	      XCommand
-> K (Either (Either MenuState b) a) (Either (Either a a) b)
-> K (Either (Either MenuState b) a) (Either (Either a a) b)
forall i o. XCommand -> K i o -> K i o
xcommandK XCommand
UngrabEvents K (Either (Either MenuState b) a) (Either (Either a a) b)
popdown
	    (Bool, MenuState)
_ -> K (Either (Either MenuState b) a) (Either (Either a a) b)
same

data MenuState = MenuDown | MenuUp MenuMode deriving (Int -> MenuState -> ShowS
[MenuState] -> ShowS
MenuState -> FontName
(Int -> MenuState -> ShowS)
-> (MenuState -> FontName)
-> ([MenuState] -> ShowS)
-> Show MenuState
forall a.
(Int -> a -> ShowS) -> (a -> FontName) -> ([a] -> ShowS) -> Show a
showList :: [MenuState] -> ShowS
$cshowList :: [MenuState] -> ShowS
show :: MenuState -> FontName
$cshow :: MenuState -> FontName
showsPrec :: Int -> MenuState -> ShowS
$cshowsPrec :: Int -> MenuState -> ShowS
Show)
type MenuMode = Bool -- True = sticky
menuDown :: MenuState
menuDown = MenuState
MenuDown
menuUpSticky :: MenuState
menuUpSticky = Bool -> MenuState
MenuUp Bool
True
menuUpMPopup :: MenuState
menuUpMPopup = Bool -> MenuState
MenuUp Bool
False
-- Invariant: menu state never changes directly from MenuDown to menuUpSticky,
-- i.e., when a menu first pops up, it always outputs menuUpMPopup

data ButtonMenuState =
  S { ButtonMenuState -> Bool
mpopup,ButtonMenuState -> Bool
othermpopup,ButtonMenuState -> Bool
sticky,ButtonMenuState -> Bool
debug::Bool, ButtonMenuState -> Size
size::Size } deriving (Int -> ButtonMenuState -> ShowS
[ButtonMenuState] -> ShowS
ButtonMenuState -> FontName
(Int -> ButtonMenuState -> ShowS)
-> (ButtonMenuState -> FontName)
-> ([ButtonMenuState] -> ShowS)
-> Show ButtonMenuState
forall a.
(Int -> a -> ShowS) -> (a -> FontName) -> ([a] -> ShowS) -> Show a
showList :: [ButtonMenuState] -> ShowS
$cshowList :: [ButtonMenuState] -> ShowS
show :: ButtonMenuState -> FontName
$cshow :: ButtonMenuState -> FontName
showsPrec :: Int -> ButtonMenuState -> ShowS
$cshowsPrec :: Int -> ButtonMenuState -> ShowS
Show)
bstate0 :: ButtonMenuState
bstate0 = Bool -> Bool -> Bool -> Bool -> Size -> ButtonMenuState
S Bool
False Bool
False Bool
False Bool
False Size
0

{-
buttonMenuF :: (Graphic a) =>
	 LayoutDir -> FontName -> a ->
	 [(b, [(ModState, KeySym)])] ->
	 F (Either MenuState b) b ->
	 F (Either MenuState (Either a b)) (Either MenuState b)
-}
buttonMenuF :: LayoutDir
-> FontName
-> lbl
-> [(a, [(ModState, FontName)])]
-> F (Either MenuState b) a
-> F (Either MenuState (Either lbl b)) (Either MenuState a)
buttonMenuF LayoutDir
x = Bool
-> LayoutDir
-> FontName
-> lbl
-> [(a, [(ModState, FontName)])]
-> F (Either MenuState b) a
-> F (Either MenuState (Either lbl b)) (Either MenuState a)
forall lbl a b.
Graphic lbl =>
Bool
-> LayoutDir
-> FontName
-> lbl
-> [(a, [(ModState, FontName)])]
-> F (Either MenuState b) a
-> F (Either MenuState (Either lbl b)) (Either MenuState a)
buttonMenuF' Bool
False LayoutDir
x
buttonMenuF' :: Bool
-> LayoutDir
-> FontName
-> lbl
-> [(a, [(ModState, FontName)])]
-> F (Either MenuState b) a
-> F (Either MenuState (Either lbl b)) (Either MenuState a)
buttonMenuF' Bool
delayed LayoutDir
dir FontName
fname lbl
name [(a, [(ModState, FontName)])]
alts F (Either MenuState b) a
menuAltsF =
    F (Either
     (Either a (Either MenuState (Either lbl b)))
     (Either (Either Bool lbl) (Either PopupMenu (Either MenuState b))))
  (Either
     (Either
        (Either (Either Bool lbl) (Either PopupMenu (Either MenuState b)))
        (Either MenuState a))
     a)
-> F (Either MenuState (Either lbl b)) (Either MenuState a)
forall a b c d.
F (Either (Either a b) c) (Either (Either c d) a) -> F b d
loopCompThroughRightF (F (Either
      (Either a (Either MenuState (Either lbl b)))
      (Either (Either Bool lbl) (Either PopupMenu (Either MenuState b))))
   (Either
      (Either
         (Either (Either Bool lbl) (Either PopupMenu (Either MenuState b)))
         (Either MenuState a))
      a)
 -> F (Either MenuState (Either lbl b)) (Either MenuState a))
-> F (Either
        (Either a (Either MenuState (Either lbl b)))
        (Either (Either Bool lbl) (Either PopupMenu (Either MenuState b))))
     (Either
        (Either
           (Either (Either Bool lbl) (Either PopupMenu (Either MenuState b)))
           (Either MenuState a))
        a)
-> F (Either MenuState (Either lbl b)) (Either MenuState a)
forall a b. (a -> b) -> a -> b
$
    FontName
-> F (Either
        (Either a (Either MenuState (Either lbl b)))
        (Either (Either Bool lbl) (Either PopupMenu (Either MenuState b))))
     (Either
        (Either
           (Either (Either Bool lbl) (Either PopupMenu (Either MenuState b)))
           (Either MenuState a))
        a)
-> F (Either
        (Either a (Either MenuState (Either lbl b)))
        (Either (Either Bool lbl) (Either PopupMenu (Either MenuState b))))
     (Either
        (Either
           (Either (Either Bool lbl) (Either PopupMenu (Either MenuState b)))
           (Either MenuState a))
        a)
forall a b. FontName -> F a b -> F a b
showCommandF FontName
"buttonMenuF" (F (Either
      (Either a (Either MenuState (Either lbl b)))
      (Either (Either Bool lbl) (Either PopupMenu (Either MenuState b))))
   (Either
      (Either
         (Either (Either Bool lbl) (Either PopupMenu (Either MenuState b)))
         (Either MenuState a))
      a)
 -> F (Either
         (Either a (Either MenuState (Either lbl b)))
         (Either (Either Bool lbl) (Either PopupMenu (Either MenuState b))))
      (Either
         (Either
            (Either (Either Bool lbl) (Either PopupMenu (Either MenuState b)))
            (Either MenuState a))
         a))
-> F (Either
        (Either a (Either MenuState (Either lbl b)))
        (Either (Either Bool lbl) (Either PopupMenu (Either MenuState b))))
     (Either
        (Either
           (Either (Either Bool lbl) (Either PopupMenu (Either MenuState b)))
           (Either MenuState a))
        a)
-> F (Either
        (Either a (Either MenuState (Either lbl b)))
        (Either (Either Bool lbl) (Either PopupMenu (Either MenuState b))))
     (Either
        (Either
           (Either (Either Bool lbl) (Either PopupMenu (Either MenuState b)))
           (Either MenuState a))
        a)
forall a b. (a -> b) -> a -> b
$
    [FRequest]
-> K (Either a (Either MenuState (Either lbl b)))
     (Either
        (Either (Either Bool lbl) (Either PopupMenu (Either MenuState b)))
        (Either MenuState a))
-> F (Either
        (Either Bool lbl) (Either PopupMenu (Either MenuState b)))
     a
-> F (Either
        (Either a (Either MenuState (Either lbl b)))
        (Either (Either Bool lbl) (Either PopupMenu (Either MenuState b))))
     (Either
        (Either
           (Either (Either Bool lbl) (Either PopupMenu (Either MenuState b)))
           (Either MenuState a))
        a)
forall a b c d.
[FRequest] -> K a b -> F c d -> F (Either a c) (Either b d)
groupF [FRequest]
startcmds
	   ((ButtonMenuState
 -> KEvent (Either a (Either MenuState (Either lbl b)))
 -> (ButtonMenuState,
     [KCommand
        (Either
           (Either (Either Bool lbl) (Either PopupMenu (Either MenuState b)))
           (Either MenuState a))]))
-> ButtonMenuState
-> K (Either a (Either MenuState (Either lbl b)))
     (Either
        (Either (Either Bool lbl) (Either PopupMenu (Either MenuState b)))
        (Either MenuState a))
forall t hi ho.
(t -> KEvent hi -> (t, [KCommand ho])) -> t -> K hi ho
mapstateK ButtonMenuState
-> KEvent (Either a (Either MenuState (Either lbl b)))
-> (ButtonMenuState,
    [KCommand
       (Either
          (Either (Either Bool lbl) (Either PopupMenu (Either MenuState b)))
          (Either MenuState a))])
forall b b a.
ButtonMenuState
-> Message FResponse (Either a (Either MenuState (Either b b)))
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState a))])
proc ButtonMenuState
bstate0)
	   (SP (Either (GfxEvent [Int]) a) a
forall a1 b. SP (Either a1 b) b
filterRightSP SP (Either (GfxEvent [Int]) a) a
-> F (Either
        (Either Bool lbl) (Either PopupMenu (Either MenuState b)))
     (Either (GfxEvent [Int]) a)
-> F (Either
        (Either Bool lbl) (Either PopupMenu (Either MenuState b)))
     a
forall a b e. SP a b -> F e a -> F e b
>^^=< (FontName -> lbl -> F (Either Bool lbl) (GfxEvent [Int])
forall lbl.
Graphic lbl =>
FontName -> lbl -> F (Either Bool lbl) (GfxEvent [Int])
menuLabelF FontName
fname lbl
name F (Either Bool lbl) (GfxEvent [Int])
-> F (Either PopupMenu (Either MenuState b)) a
-> F (Either
        (Either Bool lbl) (Either PopupMenu (Either MenuState b)))
     (Either (GfxEvent [Int]) a)
forall a b c d. F a b -> F c d -> F (Either a c) (Either b d)
>+< F (Either PopupMenu (Either MenuState b)) a
theMenuF))
  where
    theMenuF :: F (Either PopupMenu (Either MenuState b)) a
theMenuF = Bool
-> F (Either MenuState b) a
-> F (Either PopupMenu (Either MenuState b)) a
forall b d. Bool -> F b d -> F (Either PopupMenu b) d
menuPopupF' Bool
delayed F (Either MenuState b) a
menuAltsF
    topopup :: a -> Message a (Either (Either a (Either a b)) b)
topopup = Either (Either a (Either a b)) b
-> Message a (Either (Either a (Either a b)) b)
forall a b. b -> Message a b
High (Either (Either a (Either a b)) b
 -> Message a (Either (Either a (Either a b)) b))
-> (a -> Either (Either a (Either a b)) b)
-> a
-> Message a (Either (Either a (Either a b)) b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a (Either a b) -> Either (Either a (Either a b)) b
forall a b. a -> Either a b
Left (Either a (Either a b) -> Either (Either a (Either a b)) b)
-> (a -> Either a (Either a b))
-> a
-> Either (Either a (Either a b)) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a b -> Either a (Either a b)
forall a b. b -> Either a b
Right (Either a b -> Either a (Either a b))
-> (a -> Either a b) -> a -> Either 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
    tosubmenus :: a -> Message a (Either (Either a (Either a (Either a b))) b)
tosubmenus = Either (Either a (Either a (Either a b))) b
-> Message a (Either (Either a (Either a (Either a b))) b)
forall a b. b -> Message a b
High (Either (Either a (Either a (Either a b))) b
 -> Message a (Either (Either a (Either a (Either a b))) b))
-> (a -> Either (Either a (Either a (Either a b))) b)
-> a
-> Message a (Either (Either a (Either a (Either a b))) b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a (Either a (Either a b))
-> Either (Either a (Either a (Either a b))) b
forall a b. a -> Either a b
Left (Either a (Either a (Either a b))
 -> Either (Either a (Either a (Either a b))) b)
-> (a -> Either a (Either a (Either a b)))
-> a
-> Either (Either a (Either a (Either a b))) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a (Either a b) -> Either a (Either a (Either a b))
forall a b. b -> Either a b
Right (Either a (Either a b) -> Either a (Either a (Either a b)))
-> (a -> Either a (Either a b))
-> a
-> Either a (Either a (Either a b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a b -> Either a (Either a b)
forall a b. b -> Either a b
Right (Either a b -> Either a (Either a b))
-> (a -> Either a b) -> a -> Either 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
    inputtosubmenus :: b -> Message a (Either (Either a (Either a (Either a b))) b)
inputtosubmenus = Either (Either a (Either a (Either a b))) b
-> Message a (Either (Either a (Either a (Either a b))) b)
forall a b. b -> Message a b
High (Either (Either a (Either a (Either a b))) b
 -> Message a (Either (Either a (Either a (Either a b))) b))
-> (b -> Either (Either a (Either a (Either a b))) b)
-> b
-> Message a (Either (Either a (Either a (Either a b))) b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a (Either a (Either a b))
-> Either (Either a (Either a (Either a b))) b
forall a b. a -> Either a b
Left (Either a (Either a (Either a b))
 -> Either (Either a (Either a (Either a b))) b)
-> (b -> Either a (Either a (Either a b)))
-> b
-> Either (Either a (Either a (Either a b))) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a (Either a b) -> Either a (Either a (Either a b))
forall a b. b -> Either a b
Right (Either a (Either a b) -> Either a (Either a (Either a b)))
-> (b -> Either a (Either a b))
-> b
-> Either a (Either a (Either a b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a b -> Either a (Either a b)
forall a b. b -> Either a b
Right (Either a b -> Either a (Either a b))
-> (b -> Either a b) -> b -> Either 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
    out :: b -> Message a (Either a (Either a b))
out = Either a (Either a b) -> Message a (Either a (Either a b))
forall a b. b -> Message a b
High (Either a (Either a b) -> Message a (Either a (Either a b)))
-> (b -> Either a (Either a b))
-> b
-> Message a (Either a (Either a b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a b -> Either a (Either a b)
forall a b. b -> Either a b
Right (Either a b -> Either a (Either a b))
-> (b -> Either a b) -> b -> Either 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
    othermenu :: a -> Message a (Either a (Either a b))
othermenu = Either a (Either a b) -> Message a (Either a (Either a b))
forall a b. b -> Message a b
High (Either a (Either a b) -> Message a (Either a (Either a b)))
-> (a -> Either a (Either a b))
-> a
-> Message a (Either a (Either a b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a b -> Either a (Either a b)
forall a b. b -> Either a b
Right (Either a b -> Either a (Either a b))
-> (a -> Either a b) -> a -> Either 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
    toDisp :: a -> Message a (Either (Either a b) b)
toDisp = Either (Either a b) b -> Message a (Either (Either a b) b)
forall a b. b -> Message a b
High (Either (Either a b) b -> Message a (Either (Either a b) b))
-> (a -> Either (Either a b) b)
-> a
-> Message a (Either (Either a b) b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a b -> Either (Either a b) b
forall a b. a -> Either a b
Left (Either a b -> Either (Either a b) b)
-> (a -> Either a b) -> a -> Either (Either a b) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a b
forall a b. a -> Either a b
Left
    relabel :: b -> Message a (Either (Either (Either a b) b) b)
relabel = Either a b -> Message a (Either (Either (Either a b) b) b)
forall a a b b. a -> Message a (Either (Either a b) b)
toDisp (Either a b -> Message a (Either (Either (Either a b) b) b))
-> (b -> Either a b)
-> b
-> Message a (Either (Either (Either a b) b) b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either a b
forall a b. b -> Either a b
Right
    adjust :: Size -> Size
adjust =
	case LayoutDir
dir of
	  LayoutDir
Vertical -> \ (Point Int
w Int
_) -> Int -> Int -> Size
pP Int
w (-Int
1)
	  LayoutDir
Horizontal -> \ (Point Int
_ Int
h) -> Int -> Int -> Size
pP (-Int
1) Int
h
    proc :: ButtonMenuState
-> Message FResponse (Either a (Either MenuState (Either b b)))
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState a))])
proc state :: ButtonMenuState
state@(S{mpopup :: ButtonMenuState -> Bool
mpopup=Bool
mpopup,othermpopup :: ButtonMenuState -> Bool
othermpopup=Bool
othermpopup,sticky :: ButtonMenuState -> Bool
sticky=Bool
sticky,size :: ButtonMenuState -> Size
size=Size
size,debug :: ButtonMenuState -> Bool
debug=Bool
debug}) =
	(FResponse
 -> (ButtonMenuState,
     [Message
        a
        (Either
           (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
           (Either MenuState a))]))
-> (Either a (Either MenuState (Either b b))
    -> (ButtonMenuState,
        [Message
           a
           (Either
              (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
              (Either MenuState a))]))
-> Message FResponse (Either a (Either MenuState (Either b b)))
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState a))])
forall t1 p t2. (t1 -> p) -> (t2 -> p) -> Message t1 t2 -> p
message FResponse
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState a))])
forall a b b.
FResponse
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState a))])
low Either a (Either MenuState (Either b b))
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState a))])
forall b b b a a.
Either b (Either MenuState (Either b b))
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either a b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState b))])
high
      where
	dbg :: FontName -> a -> a
dbg FontName
x = if Bool
debug then FontName -> a -> a
forall a. FontName -> a -> a
trace (FontName
"buttonMenuF "FontName -> ShowS
forall a. [a] -> [a] -> [a]
++FontName
x) else a -> a
forall a. a -> a
id

	popdownyield :: (ButtonMenuState,
 [Message
    a (Either (Either a (Either PopupMenu (Either MenuState b))) b)])
popdownyield = Bool
-> [Message
      a (Either (Either a (Either PopupMenu (Either MenuState b))) b)]
-> (ButtonMenuState,
    [Message
       a (Either (Either a (Either PopupMenu (Either MenuState b))) b)])
forall a a b b.
Bool
-> [Message
      a (Either (Either a (Either PopupMenu (Either MenuState b))) b)]
-> (ButtonMenuState,
    [Message
       a (Either (Either a (Either PopupMenu (Either MenuState b))) b)])
popdown' Bool
True [] --pop down because other menu popped up
	popdownlast :: (ButtonMenuState,
 [Message
    a
    (Either
       (Either a (Either PopupMenu (Either MenuState b)))
       (Either MenuState b))])
popdownlast = -- pop down, no other menu is up
	  FontName
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either a (Either PopupMenu (Either MenuState b)))
          (Either MenuState b))])
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either a (Either PopupMenu (Either MenuState b)))
          (Either MenuState b))])
forall a. FontName -> a -> a
dbg FontName
"popdownlast" ((ButtonMenuState,
  [Message
     a
     (Either
        (Either a (Either PopupMenu (Either MenuState b)))
        (Either MenuState b))])
 -> (ButtonMenuState,
     [Message
        a
        (Either
           (Either a (Either PopupMenu (Either MenuState b)))
           (Either MenuState b))]))
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either a (Either PopupMenu (Either MenuState b)))
          (Either MenuState b))])
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either a (Either PopupMenu (Either MenuState b)))
          (Either MenuState b))])
forall a b. (a -> b) -> a -> b
$
	  Bool
-> [Message
      a
      (Either
         (Either a (Either PopupMenu (Either MenuState b)))
         (Either MenuState b))]
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either a (Either PopupMenu (Either MenuState b)))
          (Either MenuState b))])
forall a a b b.
Bool
-> [Message
      a (Either (Either a (Either PopupMenu (Either MenuState b))) b)]
-> (ButtonMenuState,
    [Message
       a (Either (Either a (Either PopupMenu (Either MenuState b))) b)])
popdown' Bool
False [MenuState
-> Message
     a
     (Either
        (Either a (Either PopupMenu (Either MenuState b)))
        (Either MenuState b))
forall a a a b. a -> Message a (Either a (Either a b))
othermenu MenuState
MenuDown]
	popdown' :: Bool
-> [Message
      a (Either (Either a (Either PopupMenu (Either MenuState b))) b)]
-> (ButtonMenuState,
    [Message
       a (Either (Either a (Either PopupMenu (Either MenuState b))) b)])
popdown' Bool
mpopup' [Message
   a (Either (Either a (Either PopupMenu (Either MenuState b))) b)]
msgs =
	  (ButtonMenuState
state{othermpopup :: Bool
othermpopup=Bool
mpopup'},
	   [Message
   a (Either (Either a (Either PopupMenu (Either MenuState b))) b)]
msgs[Message
   a (Either (Either a (Either PopupMenu (Either MenuState b))) b)]
-> [Message
      a (Either (Either a (Either PopupMenu (Either MenuState b))) b)]
-> [Message
      a (Either (Either a (Either PopupMenu (Either MenuState b))) b)]
forall a. [a] -> [a] -> [a]
++[MenuState
-> Message
     a (Either (Either a (Either PopupMenu (Either MenuState b))) b)
forall a a a a b b.
a -> Message a (Either (Either a (Either a (Either a b))) b)
tosubmenus MenuState
menuDown,PopupMenu
-> Message
     a (Either (Either a (Either PopupMenu (Either MenuState b))) b)
forall a a a b b. a -> Message a (Either (Either a (Either a b)) b)
topopup PopupMenu
PopdownMenu])

	stickyMode :: (ButtonMenuState,
 [Message
    a (Either (Either a (Either PopupMenu b)) (Either MenuState b))])
stickyMode =
	  FontName
-> (ButtonMenuState,
    [Message
       a (Either (Either a (Either PopupMenu b)) (Either MenuState b))])
-> (ButtonMenuState,
    [Message
       a (Either (Either a (Either PopupMenu b)) (Either MenuState b))])
forall a. FontName -> a -> a
dbg FontName
"othermenu menuUpSticky" ((ButtonMenuState,
  [Message
     a (Either (Either a (Either PopupMenu b)) (Either MenuState b))])
 -> (ButtonMenuState,
     [Message
        a (Either (Either a (Either PopupMenu b)) (Either MenuState b))]))
-> (ButtonMenuState,
    [Message
       a (Either (Either a (Either PopupMenu b)) (Either MenuState b))])
-> (ButtonMenuState,
    [Message
       a (Either (Either a (Either PopupMenu b)) (Either MenuState b))])
forall a b. (a -> b) -> a -> b
$
	  (ButtonMenuState
state{sticky :: Bool
sticky=Bool
True},
	   [MenuState
-> Message
     a (Either (Either a (Either PopupMenu b)) (Either MenuState b))
forall a a a b. a -> Message a (Either a (Either a b))
othermenu MenuState
menuUpSticky,PopupMenu
-> Message
     a (Either (Either a (Either PopupMenu b)) (Either MenuState b))
forall a a a b b. a -> Message a (Either (Either a (Either a b)) b)
topopup PopupMenu
PopupMenuStick])

	mPopupMode :: Bool -> (ButtonMenuState, [a])
mPopupMode Bool
b = (ButtonMenuState
state{mpopup :: Bool
mpopup=Bool
b},[])
	highlight :: a -> Message a (Either (Either (Either a b) b) b)
highlight = Either a b -> Message a (Either (Either (Either a b) b) b)
forall a a b b. a -> Message a (Either (Either a b) b)
toDisp (Either a b -> Message a (Either (Either (Either a b) b) b))
-> (a -> Either a b)
-> a
-> Message a (Either (Either (Either a b) b) b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a b
forall a b. a -> Either a b
Left
	put :: b -> (ButtonMenuState, b)
put b
msgs = (ButtonMenuState
state,b
msgs)

	high :: Either b (Either MenuState (Either b b))
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either a b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState b))])
high = (b
 -> (ButtonMenuState,
     [Message
        a
        (Either
           (Either (Either a b) (Either PopupMenu (Either MenuState b)))
           (Either MenuState b))]))
-> (Either MenuState (Either b b)
    -> (ButtonMenuState,
        [Message
           a
           (Either
              (Either (Either a b) (Either PopupMenu (Either MenuState b)))
              (Either MenuState b))]))
-> Either b (Either MenuState (Either b b))
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either a b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState b))])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either b
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either a b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState b))])
forall b a a a b.
b
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either a (Either a (Either MenuState b))) (Either MenuState b))])
fromMenu ((MenuState
 -> (ButtonMenuState,
     [Message
        a
        (Either
           (Either (Either a b) (Either PopupMenu (Either MenuState b)))
           (Either MenuState b))]))
-> (Either b b
    -> (ButtonMenuState,
        [Message
           a
           (Either
              (Either (Either a b) (Either PopupMenu (Either MenuState b)))
              (Either MenuState b))]))
-> Either MenuState (Either b b)
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either a b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState b))])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either MenuState
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either a b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState b))])
forall a a b b.
MenuState
-> (ButtonMenuState,
    [Message
       a (Either (Either a (Either PopupMenu (Either MenuState b))) b)])
fromOtherMenu Either b b
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either a b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState b))])
forall b b a a a a b.
Either b b
-> (ButtonMenuState,
    [Message
       a (Either (Either (Either a b) (Either a (Either a b))) b)])
fromOutside)
	fromOutside :: Either b b
-> (ButtonMenuState,
    [Message
       a (Either (Either (Either a b) (Either a (Either a b))) b)])
fromOutside = (b
 -> (ButtonMenuState,
     [Message
        a (Either (Either (Either a b) (Either a (Either a b))) b)]))
-> (b
    -> (ButtonMenuState,
        [Message
           a (Either (Either (Either a b) (Either a (Either a b))) b)]))
-> Either b b
-> (ButtonMenuState,
    [Message
       a (Either (Either (Either a b) (Either a (Either a b))) b)])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either b
-> (ButtonMenuState,
    [Message
       a (Either (Either (Either a b) (Either a (Either a b))) b)])
forall b a a b b.
b
-> (ButtonMenuState,
    [Message a (Either (Either (Either a b) b) b)])
newLabel b
-> (ButtonMenuState,
    [Message
       a (Either (Either (Either a b) (Either a (Either a b))) b)])
forall b a a a a b.
b
-> (ButtonMenuState,
    [Message a (Either (Either a (Either a (Either a b))) b)])
altInput
	newLabel :: b
-> (ButtonMenuState,
    [Message a (Either (Either (Either a b) b) b)])
newLabel b
lbl = (ButtonMenuState
state,[b -> Message a (Either (Either (Either a b) b) b)
forall b a a b b. b -> Message a (Either (Either (Either a b) b) b)
relabel b
lbl])
	altInput :: b
-> (ButtonMenuState,
    [Message a (Either (Either a (Either a (Either a b))) b)])
altInput b
x = (ButtonMenuState
state,[b -> Message a (Either (Either a (Either a (Either a b))) b)
forall b a a a a b.
b -> Message a (Either (Either a (Either a (Either a b))) b)
inputtosubmenus b
x])

	fromOtherMenu :: MenuState
-> (ButtonMenuState,
    [Message
       a (Either (Either a (Either PopupMenu (Either MenuState b))) b)])
fromOtherMenu MenuState
newMode =
	  FontName
-> (ButtonMenuState,
    [Message
       a (Either (Either a (Either PopupMenu (Either MenuState b))) b)])
-> (ButtonMenuState,
    [Message
       a (Either (Either a (Either PopupMenu (Either MenuState b))) b)])
forall a. FontName -> a -> a
dbg (FontName
"fromOtherMenu "FontName -> ShowS
forall a. [a] -> [a] -> [a]
++MenuState -> FontName
forall a. Show a => a -> FontName
show MenuState
newMode) ((ButtonMenuState,
  [Message
     a (Either (Either a (Either PopupMenu (Either MenuState b))) b)])
 -> (ButtonMenuState,
     [Message
        a (Either (Either a (Either PopupMenu (Either MenuState b))) b)]))
-> (ButtonMenuState,
    [Message
       a (Either (Either a (Either PopupMenu (Either MenuState b))) b)])
-> (ButtonMenuState,
    [Message
       a (Either (Either a (Either PopupMenu (Either MenuState b))) b)])
forall a b. (a -> b) -> a -> b
$
	  case MenuState
newMode of
	    MenuUp Bool
False -> (ButtonMenuState,
 [Message
    a (Either (Either a (Either PopupMenu (Either MenuState b))) b)])
forall a a b b.
(ButtonMenuState,
 [Message
    a (Either (Either a (Either PopupMenu (Either MenuState b))) b)])
popdownyield -- other menu popped up, pop down
	    MenuUp Bool
True -> (ButtonMenuState
state{othermpopup :: Bool
othermpopup=Bool
False},[])
	    MenuState
MenuDown -> Bool
-> [Message
      a (Either (Either a (Either PopupMenu (Either MenuState b))) b)]
-> (ButtonMenuState,
    [Message
       a (Either (Either a (Either PopupMenu (Either MenuState b))) b)])
forall a a b b.
Bool
-> [Message
      a (Either (Either a (Either PopupMenu (Either MenuState b))) b)]
-> (ButtonMenuState,
    [Message
       a (Either (Either a (Either PopupMenu (Either MenuState b))) b)])
popdown' Bool
False []

	fromMenu :: b
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either a (Either a (Either MenuState b))) (Either MenuState b))])
fromMenu b
alt =
	  (ButtonMenuState
state{sticky :: Bool
sticky=Bool
False},
	   [MenuState
-> Message
     a
     (Either
        (Either a (Either a (Either MenuState b))) (Either MenuState b))
forall a a a a b b.
a -> Message a (Either (Either a (Either a (Either a b))) b)
tosubmenus MenuState
menuDown,MenuState
-> Message
     a
     (Either
        (Either a (Either a (Either MenuState b))) (Either MenuState b))
forall a a a b. a -> Message a (Either a (Either a b))
othermenu MenuState
menuDown,b
-> Message
     a
     (Either
        (Either a (Either a (Either MenuState b))) (Either MenuState b))
forall b a a a. b -> Message a (Either a (Either a b))
out b
alt])
	low :: FResponse
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState a))])
low FResponse
resp =
	  FontName
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState a))])
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState a))])
forall a. FontName -> a -> a
dbg ([FontName] -> FontName
unlines [ButtonMenuState -> FontName
forall a. Show a => a -> FontName
show ButtonMenuState
state, FResponse -> FontName
forall a. Show a => a -> FontName
show FResponse
resp,FontName
""]) ((ButtonMenuState,
  [Message
     a
     (Either
        (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
        (Either MenuState a))])
 -> (ButtonMenuState,
     [Message
        a
        (Either
           (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
           (Either MenuState a))]))
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState a))])
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState a))])
forall a b. (a -> b) -> a -> b
$
	  case FResponse
resp of
	    XEvt XEvent
event ->
	      case XEvent
event of
		ButtonEvent {button :: XEvent -> Button
button=Button Int
2,type' :: XEvent -> Pressed
type'=Pressed
Pressed,state :: XEvent -> ModState
state=ModState
mods} ->
		  FontName
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState a))])
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState a))])
forall a. FontName -> a -> a
trace FontName
"Button 2" ((ButtonMenuState,
  [Message
     a
     (Either
        (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
        (Either MenuState a))])
 -> (ButtonMenuState,
     [Message
        a
        (Either
           (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
           (Either MenuState a))]))
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState a))])
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState a))])
forall a b. (a -> b) -> a -> b
$
		  (ButtonMenuState
state{debug :: Bool
debug=Modifiers
Control Modifiers -> ModState -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ModState
mods},[])
		--ButtonEvent _ winpos rootpos mods Pressed (Button 1) ->
		ButtonEvent {pos :: XEvent -> Size
pos=Size
winpos,rootPos :: XEvent -> Size
rootPos=Size
rootpos,state :: XEvent -> ModState
state=ModState
mods,type' :: XEvent -> Pressed
type'=Pressed
Pressed,button :: XEvent -> Button
button=Button Int
1} ->
		  FontName
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState a))])
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState a))])
forall a. FontName -> a -> a
dbg FontName
"output othermenu True" ((ButtonMenuState,
  [Message
     a
     (Either
        (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
        (Either MenuState a))])
 -> (ButtonMenuState,
     [Message
        a
        (Either
           (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
           (Either MenuState a))]))
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState a))])
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState a))])
forall a b. (a -> b) -> a -> b
$
		  (ButtonMenuState
state{sticky :: Bool
sticky=Bool
False},
		   [MenuState
-> Message
     a
     (Either
        (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
        (Either MenuState a))
forall a a a b. a -> Message a (Either a (Either a b))
othermenu MenuState
menuUpMPopup, -- tell other menus to pop down
		    PopupMenu
-> Message
     a
     (Either
        (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
        (Either MenuState a))
forall a a a b b. a -> Message a (Either (Either a (Either a b)) b)
topopup (Size -> XEvent -> PopupMenu
PopupMenu (Size
rootposSize -> Size -> Size
forall a. Num a => a -> a -> a
-Size
winposSize -> Size -> Size
forall a. Num a => a -> a -> a
+Size -> Size
adjust Size
size) XEvent
event)
		    --highlight True,
		    --Low (GrabEvents False)
		    ])
		LeaveNotify {mode :: XEvent -> Mode
mode=Mode
NotifyUngrab,detail :: XEvent -> Detail
detail=Detail
NotifyInferior}
		    | Bool
stickyMenus Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
mpopup -> (ButtonMenuState,
 [Message
    a
    (Either
       (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
       (Either MenuState a))])
forall a a b b.
(ButtonMenuState,
 [Message
    a (Either (Either a (Either PopupMenu b)) (Either MenuState b))])
stickyMode
		LeaveNotify {mode :: XEvent -> Mode
mode=Mode
NotifyUngrab} {-  | not sticky-} -> (ButtonMenuState,
 [Message
    a
    (Either
       (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
       (Either MenuState a))])
forall a a b b.
(ButtonMenuState,
 [Message
    a
    (Either
       (Either a (Either PopupMenu (Either MenuState b)))
       (Either MenuState b))])
popdownlast
		--  ^^ these events get lost in focusMgr it seems
		ButtonEvent {pos :: XEvent -> Size
pos=Size
pos,button :: XEvent -> Button
button=Button Int
1,type' :: XEvent -> Pressed
type'=Pressed
Released}
		    | Bool -> Bool
not (Bool
stickyMenus Bool -> Bool -> Bool
&& Size
pos Size -> Rect -> Bool
`inRect` (Size -> Size -> Rect
Rect Size
0 Size
size)) -> (ButtonMenuState,
 [Message
    a
    (Either
       (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
       (Either MenuState a))])
forall a a b b.
(ButtonMenuState,
 [Message
    a
    (Either
       (Either a (Either PopupMenu (Either MenuState b)))
       (Either MenuState b))])
popdownlast
			     --workaround
		LeaveNotify {detail :: XEvent -> Detail
detail=Detail
detail}
		    | Detail
detailDetail -> Detail -> Bool
forall a. Eq a => a -> a -> Bool
/=Detail
NotifyInferior ->
			if Bool
False --mpopup
			then (ButtonMenuState,
 [Message
    a
    (Either
       (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
       (Either MenuState a))])
forall a a b b.
(ButtonMenuState,
 [Message
    a
    (Either
       (Either a (Either PopupMenu (Either MenuState b)))
       (Either MenuState b))])
popdownlast
			else [Message
   a
   (Either
      (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
      (Either MenuState a))]
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState a))])
forall b. b -> (ButtonMenuState, b)
put [Bool
-> Message
     a
     (Either
        (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
        (Either MenuState a))
forall a a b b b. a -> Message a (Either (Either (Either a b) b) b)
highlight Bool
False]
		EnterNotify {rootPos :: XEvent -> Size
rootPos=Size
rootpos,pos :: XEvent -> Size
pos=Size
winpos,mode :: XEvent -> Mode
mode=Mode
NotifyNormal}
		  | Bool
mpopup Bool -> Bool -> Bool
|| Bool
othermpopup ->
		      FontName
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState a))])
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState a))])
forall a. FontName -> a -> a
dbg FontName
"output othermenu True" ((ButtonMenuState,
  [Message
     a
     (Either
        (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
        (Either MenuState a))])
 -> (ButtonMenuState,
     [Message
        a
        (Either
           (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
           (Either MenuState a))]))
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState a))])
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState a))])
forall a b. (a -> b) -> a -> b
$
		      (ButtonMenuState
state{sticky :: Bool
sticky=Bool
False},
		       [MenuState
-> Message
     a
     (Either
        (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
        (Either MenuState a))
forall a a a b. a -> Message a (Either a (Either a b))
othermenu MenuState
menuUpMPopup, -- tell other menus to pop down
			PopupMenu
-> Message
     a
     (Either
        (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
        (Either MenuState a))
forall a a a b b. a -> Message a (Either (Either a (Either a b)) b)
topopup (Size -> XEvent -> PopupMenu
PopupMenu (Size
rootposSize -> Size -> Size
forall a. Num a => a -> a -> a
-Size
winposSize -> Size -> Size
forall a. Num a => a -> a -> a
+Size -> Size
adjust Size
size) XEvent
event),
			Bool
-> Message
     a
     (Either
        (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
        (Either MenuState a))
forall a a b b b. a -> Message a (Either (Either (Either a b) b) b)
highlight Bool
True])
		  | Bool
otherwise -> [Message
   a
   (Either
      (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
      (Either MenuState a))]
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState a))])
forall b. b -> (ButtonMenuState, b)
put [Bool
-> Message
     a
     (Either
        (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
        (Either MenuState a))
forall a a b b b. a -> Message a (Either (Either (Either a b) b) b)
highlight Bool
True]
		KeyEvent {state :: XEvent -> ModState
state=ModState
s,type' :: XEvent -> Pressed
type'=Pressed
Pressed,keySym :: XEvent -> FontName
keySym=FontName
ks} ->
		  case [ a
a | (a
a,[(ModState, FontName)]
keys) <- [(a, [(ModState, FontName)])]
alts, (ModState
s,FontName
ks) (ModState, FontName) -> [(ModState, FontName)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(ModState, FontName)]
keys] of
		    a
a:[a]
_ -> [Message
   a
   (Either
      (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
      (Either MenuState a))]
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState a))])
forall b. b -> (ButtonMenuState, b)
put [a
-> Message
     a
     (Either
        (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
        (Either MenuState a))
forall b a a a. b -> Message a (Either a (Either a b))
out a
a]
		    [a]
_ -> FontName
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState a))])
forall a. HasCallStack => FontName -> a
error FontName
"MenuF.clickF bug"
		MenuPopupMode Bool
b -> Bool
-> (ButtonMenuState,
    [Message
       a
       (Either
          (Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
          (Either MenuState a))])
forall a. Bool -> (ButtonMenuState, [a])
mPopupMode Bool
b
		XEvent
_ -> (ButtonMenuState
state,[])
	    LEvt (LayoutSize Size
size') -> (ButtonMenuState
state{size :: Size
size=Size
size'},[])
	    FResponse
_ -> (ButtonMenuState
state,[])

    startcmds :: [FRequest]
startcmds = (XCommand -> FRequest) -> [XCommand] -> [FRequest]
forall a b. (a -> b) -> [a] -> [b]
map XCommand -> FRequest
XCmd (XCommand
MeButtonMachine XCommand -> [XCommand] -> [XCommand]
forall a. a -> [a] -> [a]
: [XCommand]
grab [XCommand] -> [XCommand] -> [XCommand]
forall a. [a] -> [a] -> [a]
++
	                  [[WindowChanges] -> XCommand
ConfigureWindow [Int -> WindowChanges
CWBorderWidth Int
1],
			   [WindowAttributes] -> XCommand
ChangeWindowAttributes [WindowAttributes]
wattrs] [XCommand] -> [XCommand] -> [XCommand]
forall a. [a] -> [a] -> [a]
++
			  [XCommand]
transinit)
    grab :: [XCommand]
grab = [Bool -> Button -> ModState -> [EventMask] -> XCommand
GrabButton Bool
True (Int -> Button
Button Int
1) [] [EventMask]
ptrmask]
    ptrmask :: [EventMask]
ptrmask = [EventMask
ButtonPressMask, EventMask
ButtonReleaseMask]
    wattrs :: [WindowAttributes]
wattrs = [[EventMask] -> WindowAttributes
CWEventMask [EventMask]
eventmask]
    eventmask :: [EventMask]
eventmask = [EventMask
LeaveWindowMask, EventMask
EnterWindowMask,
		 EventMask
ButtonPressMask -- Button 2 press, for debuggin only!
		]

    keys :: [(ModState, FontName)]
keys = ((a, [(ModState, FontName)]) -> [(ModState, FontName)])
-> [(a, [(ModState, FontName)])] -> [(ModState, FontName)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (a, [(ModState, FontName)]) -> [(ModState, FontName)]
forall a b. (a, b) -> b
snd [(a, [(ModState, FontName)])]
alts

    transinit :: [XCommand]
transinit =
        if [(ModState, FontName)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ModState, FontName)]
keys
	then []
        else  [(XEvent -> Maybe XEvent) -> [EventMask] -> XCommand
TranslateEvent XEvent -> Maybe XEvent
tobutton [EventMask
KeyPressMask, EventMask
KeyReleaseMask]]
      where
        tobutton :: XEvent -> Maybe XEvent
tobutton e :: XEvent
e@(KeyEvent {state :: XEvent -> ModState
state=ModState
s,keySym :: XEvent -> FontName
keySym=FontName
ks}) | (ModState
s, FontName
ks) (ModState, FontName) -> [(ModState, FontName)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(ModState, FontName)]
keys = XEvent -> Maybe XEvent
forall a. a -> Maybe a
Just XEvent
e
	tobutton XEvent
_ = Maybe XEvent
forall a. Maybe a
Nothing

stickyMenus :: Bool
stickyMenus = FontName -> Bool -> Bool
argFlag FontName
"stickymenus" Bool
False