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 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 = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry 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 =
forall a. F a a -> F a a
bypassF ((Array Int alt
naltsforall i e. Ix i => Array i e -> i -> e
!) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {b}. EqSnd a b -> b
sndEqSnd forall a b e. (a -> b) -> F e a -> F e b
>^=<
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 forall {a} {b}. EqSnd a b -> a
fstEqSnd forall c d e. F c d -> SP e c -> F e d
>=^^< forall a b. SP a b
nullSP)
where
([alt]
alts,[albl]
lbls) = forall a b. [(a, b)] -> ([a], [b])
unzip [(alt, albl)]
altlbls
lblns :: [EqSnd albl Int]
lblns = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a b. a -> b -> EqSnd a b
EqSnd [albl]
lbls [Int]
ixs
n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [alt]
alts
ixs :: [Int]
ixs = [Int
1 .. Int
n]
nalts :: Array Int alt
nalts = forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (Int
1,Int
n) (forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
ixs [alt]
alts)
FontName
fname a
name = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
forall {b} {a} {d}.
[(b, [(ModState, FontName)])]
-> F (Either a b) (Either MenuState d) -> F b d
grabberF [] (forall {b} {a} {b}.
Graphic b =>
LayoutDir
-> FontName
-> b
-> [(a, [(ModState, FontName)])]
-> F (Either MenuState b) a
-> F (Either MenuState (Either b b)) (Either MenuState a)
buttonMenuF LayoutDir
Horizontal FontName
fname a
name [(b, [(ModState, FontName)])]
alts forall {a1}. F (Either a1 (b, c)) b
menuAltsforall c d e. F c d -> (e -> c) -> F e d
>=^<forall {t1} {a} {t2} {b}.
(t1 -> a) -> (t2 -> b) -> Either t1 t2 -> Either a b
mapEither forall a. a -> a
id forall a b. a -> Either a b
Left)
where
menuAlts :: F (Either a1 (b, c)) b
menuAlts = forall {b} {b}.
(Eq b, Graphic b) =>
FontName -> [b] -> (b -> b) -> F (b, b) b
menuAltsF' FontName
fname (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(b, [(ModState, FontName)])]
alts) b -> c
show_alt forall c d e. F c d -> SP e c -> F e d
>=^^< forall {a1} {b}. SP (Either a1 b) b
filterRightSP
FontName
fname [b]
alts b -> b
show_alt =
forall a b. (a, b) -> a
fst forall a b e. (a -> b) -> F e a -> F e b
>^=< forall {a} {b} {c}.
Eq a =>
Placer -> [(a, F b c)] -> F (a, b) (a, c)
listLF (Int -> Placer
verticalP' Int
0) (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, 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 =
forall {b} {d}. F b d -> F (Either PopupMenu b) d
menuPopupF (forall {b} {b}.
(Eq b, Graphic b) =>
FontName -> [b] -> (b -> b) -> F (b, b) b
menuAltsF' FontName
fname [d]
alts d -> b
show_alt) forall c d e. F c d -> (e -> c) -> F e d
>=^< forall a b. a -> Either a b
Left
grabberF :: [(b, [(ModState, FontName)])]
-> F (Either a b) (Either MenuState d) -> F b d
grabberF [(b, [(ModState, FontName)])]
alts F (Either a b) (Either MenuState d)
mF = forall a b c d.
F (Either (Either a b) c) (Either (Either c d) a) -> F b d
loopCompThroughRightF (forall {a} {b} {c} {d}.
[FRequest] -> K a b -> F c d -> F (Either a c) (Either b d)
groupF [FRequest]
startcmds forall {b} {a}.
K (Either (Either MenuState b) b) (Either (Either a b) b)
grabK0 F (Either a b) (Either MenuState d)
mF)
where
startcmds :: [FRequest]
startcmds = forall a b. (a -> b) -> [a] -> [b]
map XCommand -> FRequest
XCmd [XCommand]
transinit
grabK0 :: K (Either (Either MenuState b) b) (Either (Either a b) b)
grabK0 = forall {b} {a}.
Bool -> K (Either (Either MenuState b) b) (Either (Either a b) b)
grabK Bool
False
transinit :: [XCommand]
transinit =
if 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 = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd [(b, [(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) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(ModState, FontName)]
keys = forall a. a -> Maybe a
Just XEvent
e
tobutton XEvent
_ = forall a. Maybe a
Nothing
grabK :: Bool -> K (Either (Either MenuState b) b) (Either (Either a b) b)
grabK Bool
up = forall {hi} {ho}. Cont (K hi ho) (KEvent hi)
getK forall a b. (a -> b) -> a -> b
$ forall {t1} {t2} {t3}.
(t1 -> t2) -> (t3 -> t2) -> Message t1 t3 -> t2
message FResponse
-> K (Either (Either MenuState b) b) (Either (Either a b) b)
low Either (Either MenuState b) b
-> K (Either (Either MenuState b) b) (Either (Either a b) b)
high
where
keyalts :: [((ModState, FontName), b)]
keyalts = [((ModState, FontName)
k,b
a)|(b
a,[(ModState, FontName)]
ks)<-[(b, [(ModState, FontName)])]
alts,(ModState, FontName)
k<-[(ModState, FontName)]
ks]
same :: K (Either (Either MenuState b) b) (Either (Either a b) b)
same = Bool -> K (Either (Either MenuState b) b) (Either (Either a b) b)
grabK Bool
up
popdown :: K (Either (Either MenuState b) b) (Either (Either a b) b)
popdown = Bool -> K (Either (Either MenuState b) b) (Either (Either a b) b)
grabK Bool
False
popup :: K (Either (Either MenuState b) b) (Either (Either a b) b)
popup = Bool -> K (Either (Either MenuState b) b) (Either (Either a b) b)
grabK Bool
True
low :: FResponse
-> K (Either (Either MenuState b) b) (Either (Either a b) 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}) ->
forall {t :: * -> *} {sp :: * -> * -> *} {a} {i}.
(Foldable t, StreamProcIO sp) =>
t a -> sp i a -> sp i a
puts [forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right b
alt)|((ModState, FontName)
key,b
alt)<-[((ModState, FontName), b)]
keyalts,(ModState
s,FontName
ks)forall a. Eq a => a -> a -> Bool
==(ModState, FontName)
key] K (Either (Either MenuState b) b) (Either (Either a b) b)
same
FResponse
_ -> K (Either (Either MenuState b) b) (Either (Either a b) b)
same
high :: Either (Either MenuState b) b
-> K (Either (Either MenuState b) b) (Either (Either a b) b)
high = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Either MenuState b
-> K (Either (Either MenuState b) b) (Either (Either a b) b)
fromLoop b -> K (Either (Either MenuState b) b) (Either (Either a b) b)
fromOutside
fromLoop :: Either MenuState b
-> K (Either (Either MenuState b) b) (Either (Either a b) b)
fromLoop = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either MenuState
-> K (Either (Either MenuState b) b) (Either (Either a b) b)
menuCoordination b -> K (Either (Either MenuState b) b) (Either (Either a b) b)
menuSelection
fromOutside :: b -> K (Either (Either MenuState b) b) (Either (Either a b) b)
fromOutside b
x = forall {f :: * -> * -> *} {ho} {hi}.
FudgetIO f =>
ho -> f hi ho -> f hi ho
putHigh (forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right b
x)) K (Either (Either MenuState b) b) (Either (Either a b) b)
same
menuSelection :: b -> K (Either (Either MenuState b) b) (Either (Either a b) b)
menuSelection b
x = forall {f :: * -> * -> *} {ho} {hi}.
FudgetIO f =>
ho -> f hi ho -> f hi ho
putHigh (forall a b. b -> Either a b
Right b
x) K (Either (Either MenuState b) b) (Either (Either a b) b)
same
menuCoordination :: MenuState
-> K (Either (Either MenuState b) b) (Either (Either a b) b)
menuCoordination MenuState
newState =
case (Bool
up,MenuState
newState) of
(Bool
False,MenuUp Bool
_) ->
forall {i} {o}. XCommand -> K i o -> K i o
xcommandK (Bool -> XCommand
GrabEvents Bool
False) K (Either (Either MenuState b) b) (Either (Either a b) b)
popup
(Bool
True,MenuState
MenuDown) ->
forall {i} {o}. XCommand -> K i o -> K i o
xcommandK XCommand
UngrabEvents K (Either (Either MenuState b) b) (Either (Either a b) b)
popdown
(Bool, MenuState)
_ -> K (Either (Either MenuState b) b) (Either (Either a b) b)
same
data = | MenuMode deriving (Int -> MenuState -> ShowS
[MenuState] -> ShowS
MenuState -> FontName
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
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 = forall {b} {a} {b}.
Graphic b =>
Bool
-> LayoutDir
-> FontName
-> b
-> [(a, [(ModState, FontName)])]
-> F (Either MenuState b) a
-> F (Either MenuState (Either b b)) (Either MenuState a)
buttonMenuF' Bool
False LayoutDir
x
Bool
delayed LayoutDir
dir FontName
fname b
name [(a, [(ModState, FontName)])]
alts F (Either MenuState b) a
menuAltsF =
forall a b c d.
F (Either (Either a b) c) (Either (Either c d) a) -> F b d
loopCompThroughRightF forall a b. (a -> b) -> a -> b
$
forall a b. FontName -> F a b -> F a b
showCommandF FontName
"buttonMenuF" forall a b. (a -> b) -> a -> b
$
forall {a} {b} {c} {d}.
[FRequest] -> K a b -> F c d -> F (Either a c) (Either b d)
groupF [FRequest]
startcmds
(forall {t} {hi} {ho}.
(t -> KEvent hi -> (t, [KCommand ho])) -> t -> K hi ho
mapstateK 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)
(forall {a1} {b}. SP (Either a1 b) b
filterRightSP forall a b e. SP a b -> F e a -> F e b
>^^=< (forall lbl.
Graphic lbl =>
FontName -> lbl -> F (Either Bool lbl) (GfxEvent [Int])
menuLabelF FontName
fname b
name 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 = 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 = forall a b. b -> Message a b
High forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left
tosubmenus :: a -> Message a (Either (Either a (Either a (Either a b))) b)
tosubmenus = forall a b. b -> Message a b
High forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left
inputtosubmenus :: a -> Message a (Either (Either a (Either a (Either a a))) b)
inputtosubmenus = forall a b. b -> Message a b
High forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right
out :: a -> Message a (Either a (Either a a))
out = forall a b. b -> Message a b
High forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right
othermenu :: a -> Message a (Either a (Either a b))
othermenu = forall a b. b -> Message a b
High forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left
toDisp :: a -> Message a (Either (Either a b) b)
toDisp = forall a b. b -> Message a b
High forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left
relabel :: a -> Message a (Either (Either (Either a a) b) b)
relabel = forall {a} {a} {b} {b}. a -> Message a (Either (Either a b) b)
toDisp forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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}) =
forall {t1} {t2} {t3}.
(t1 -> t2) -> (t3 -> t2) -> Message t1 t3 -> t2
message forall {a} {b} {b}.
FResponse
-> (ButtonMenuState,
[Message
a
(Either
(Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
(Either MenuState a))])
low forall {a} {a} {b} {a} {a}.
Either a (Either MenuState (Either a b))
-> (ButtonMenuState,
[Message
a
(Either
(Either (Either a a) (Either PopupMenu (Either MenuState b)))
(Either MenuState a))])
high
where
dbg :: FontName -> a -> a
dbg FontName
x = if Bool
debug then forall a. FontName -> a -> a
trace (FontName
"buttonMenuF "forall a. [a] -> [a] -> [a]
++FontName
x) else forall a. a -> a
id
popdownyield :: (ButtonMenuState,
[Message
a (Either (Either a (Either PopupMenu (Either MenuState b))) b)])
popdownyield = 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 =
forall a. FontName -> a -> a
dbg FontName
"popdownlast" forall a b. (a -> b) -> a -> 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 [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)]
msgsforall a. [a] -> [a] -> [a]
++[forall {a} {a} {a} {a} {b} {b}.
a -> Message a (Either (Either a (Either a (Either a b))) b)
tosubmenus MenuState
menuDown,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 =
forall a. FontName -> a -> a
dbg FontName
"othermenu menuUpSticky" forall a b. (a -> b) -> a -> b
$
(ButtonMenuState
state{sticky :: Bool
sticky=Bool
True},
[forall {a} {a} {a} {b}. a -> Message a (Either a (Either a b))
othermenu MenuState
menuUpSticky,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 = forall {a} {a} {b} {b}. a -> Message a (Either (Either a b) b)
toDisp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left
put :: b -> (ButtonMenuState, b)
put b
msgs = (ButtonMenuState
state,b
msgs)
high :: Either a (Either MenuState (Either a b))
-> (ButtonMenuState,
[Message
a
(Either
(Either (Either a a) (Either PopupMenu (Either MenuState b)))
(Either MenuState a))])
high = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {b} {a} {a} {a} {b}.
b
-> (ButtonMenuState,
[Message
a
(Either
(Either a (Either a (Either MenuState b))) (Either MenuState b))])
fromMenu (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {a} {a} {b} {b}.
MenuState
-> (ButtonMenuState,
[Message
a (Either (Either a (Either PopupMenu (Either MenuState b))) b)])
fromOtherMenu forall {a} {b} {a} {a} {a} {a} {b}.
Either a b
-> (ButtonMenuState,
[Message
a (Either (Either (Either a a) (Either a (Either a b))) b)])
fromOutside)
fromOutside :: Either a b
-> (ButtonMenuState,
[Message
a (Either (Either (Either a a) (Either a (Either a b))) b)])
fromOutside = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {a} {a} {a} {b} {b}.
a
-> (ButtonMenuState,
[Message a (Either (Either (Either a a) b) b)])
newLabel forall {a} {a} {a} {a} {a} {b}.
a
-> (ButtonMenuState,
[Message a (Either (Either a (Either a (Either a a))) b)])
altInput
newLabel :: a
-> (ButtonMenuState,
[Message a (Either (Either (Either a a) b) b)])
newLabel a
lbl = (ButtonMenuState
state,[forall {a} {a} {a} {b} {b}.
a -> Message a (Either (Either (Either a a) b) b)
relabel a
lbl])
altInput :: a
-> (ButtonMenuState,
[Message a (Either (Either a (Either a (Either a a))) b)])
altInput a
x = (ButtonMenuState
state,[forall {a} {a} {a} {a} {a} {b}.
a -> Message a (Either (Either a (Either a (Either a a))) b)
inputtosubmenus a
x])
fromOtherMenu :: MenuState
-> (ButtonMenuState,
[Message
a (Either (Either a (Either PopupMenu (Either MenuState b))) b)])
fromOtherMenu MenuState
newMode =
forall a. FontName -> a -> a
dbg (FontName
"fromOtherMenu "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> FontName
show MenuState
newMode) forall a b. (a -> b) -> a -> b
$
case MenuState
newMode of
MenuUp Bool
False -> 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 -> 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},
[forall {a} {a} {a} {a} {b} {b}.
a -> Message a (Either (Either a (Either a (Either a b))) b)
tosubmenus MenuState
menuDown,forall {a} {a} {a} {b}. a -> Message a (Either a (Either a b))
othermenu MenuState
menuDown,forall {a} {a} {a} {a}. a -> Message a (Either a (Either a a))
out b
alt])
low :: FResponse
-> (ButtonMenuState,
[Message
a
(Either
(Either (Either Bool b) (Either PopupMenu (Either MenuState b)))
(Either MenuState a))])
low FResponse
resp =
forall a. FontName -> a -> a
dbg ([FontName] -> FontName
unlines [forall a. Show a => a -> FontName
show ButtonMenuState
state, forall a. Show a => a -> FontName
show FResponse
resp,FontName
""]) 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} ->
forall a. FontName -> a -> a
trace FontName
"Button 2" forall a b. (a -> b) -> a -> b
$
(ButtonMenuState
state{debug :: Bool
debug=Modifiers
Control 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} ->
forall a. FontName -> a -> a
dbg FontName
"output othermenu True" forall a b. (a -> b) -> a -> b
$
(ButtonMenuState
state{sticky :: Bool
sticky=Bool
False},
[forall {a} {a} {a} {b}. a -> Message a (Either a (Either a b))
othermenu MenuState
menuUpMPopup,
forall {a} {a} {a} {b} {b}.
a -> Message a (Either (Either a (Either a b)) b)
topopup (Size -> XEvent -> PopupMenu
PopupMenu (Size
rootposforall a. Num a => a -> a -> a
-Size
winposforall 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 -> 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} -> 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)) -> 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
detailforall a. Eq a => a -> a -> Bool
/=Detail
NotifyInferior ->
if Bool
False
then forall {a} {a} {b} {b}.
(ButtonMenuState,
[Message
a
(Either
(Either a (Either PopupMenu (Either MenuState b)))
(Either MenuState b))])
popdownlast
else forall {b}. b -> (ButtonMenuState, b)
put [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 ->
forall a. FontName -> a -> a
dbg FontName
"output othermenu True" forall a b. (a -> b) -> a -> b
$
(ButtonMenuState
state{sticky :: Bool
sticky=Bool
False},
[forall {a} {a} {a} {b}. a -> Message a (Either a (Either a b))
othermenu MenuState
menuUpMPopup,
forall {a} {a} {a} {b} {b}.
a -> Message a (Either (Either a (Either a b)) b)
topopup (Size -> XEvent -> PopupMenu
PopupMenu (Size
rootposforall a. Num a => a -> a -> a
-Size
winposforall a. Num a => a -> a -> a
+Size -> Size
adjust Size
size) XEvent
event),
forall {a} {a} {b} {b} {b}.
a -> Message a (Either (Either (Either a b) b) b)
highlight Bool
True])
| Bool
otherwise -> forall {b}. b -> (ButtonMenuState, b)
put [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) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(ModState, FontName)]
keys] of
a
a:[a]
_ -> forall {b}. b -> (ButtonMenuState, b)
put [forall {a} {a} {a} {a}. a -> Message a (Either a (Either a a))
out a
a]
[a]
_ -> forall a. HasCallStack => FontName -> a
error FontName
"MenuF.clickF bug"
MenuPopupMode Bool
b -> 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 = forall a b. (a -> b) -> [a] -> [b]
map XCommand -> FRequest
XCmd (XCommand
MeButtonMachine forall a. a -> [a] -> [a]
: [XCommand]
grab forall a. [a] -> [a] -> [a]
++
[[WindowChanges] -> XCommand
ConfigureWindow [Int -> WindowChanges
CWBorderWidth Int
1],
[WindowAttributes] -> XCommand
ChangeWindowAttributes [WindowAttributes]
wattrs] 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 = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd [(a, [(ModState, FontName)])]
alts
transinit :: [XCommand]
transinit =
if 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) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(ModState, FontName)]
keys = forall a. a -> Maybe a
Just XEvent
e
tobutton XEvent
_ = forall a. Maybe a
Nothing
= FontName -> Bool -> Bool
argFlag FontName
"stickymenus" Bool
False