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 )
import Fudget
import FRequest
import FudgetIO
import StreamProcIO
import Xcommand
import NullF
import CompOps((>^=<), (>=^<), (>=^^<), (>^^=<),(>+<))
import Dlayout(groupF)
import SerCompF(bypassF)
import Loops(loopCompThroughRightF)
import LayoutDir(LayoutDir(..))
import LayoutF(listLF)
import LayoutRequest(LayoutResponse(..))
import Placers
import Spacers()
import MenuButtonF
import MenuPopupF
import Spops(nullSP)
import MapstateK
import SpEither(filterRightSP)
import EitherUtils(mapEither)
import Xtypes
import Defaults(menuFont)
import CmdLineEnv(argFlag)
import Graphic
import Data.Array
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
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)
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
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
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) = (b
alt, FontName -> b -> F b Click
forall lbl. Graphic lbl => FontName -> lbl -> F lbl Click
menuButtonF FontName
fname (b -> b
show_alt b
alt))
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
_) ->
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) ->
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 = | 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 = Bool
= MenuState
MenuDown
= Bool -> MenuState
MenuUp Bool
True
= Bool -> MenuState
MenuUp Bool
False
data =
S { ,,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
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
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 []
popdownlast :: (ButtonMenuState,
[Message
a
(Either
(Either a (Either PopupMenu (Either MenuState b)))
(Either MenuState b))])
popdownlast =
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
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 {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,
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)
])
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} -> (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
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
LeaveNotify {detail :: XEvent -> Detail
detail=Detail
detail}
| Detail
detailDetail -> Detail -> Bool
forall a. Eq a => a -> a -> Bool
/=Detail
NotifyInferior ->
if Bool
False
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,
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
]
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
= FontName -> Bool -> Bool
argFlag FontName
"stickymenus" Bool
False