module ButtonGroupF(
	buttonGroupF, menuButtonGroupF,
	--buttonMachineF,
	BMevents(..))
where
import Command
import CompOps((>=^<))
import Defaults(bgColor)
import Dlayout(groupF)
import Event
import Fudget
import FRequest
import Xcommand
--import Geometry(Line, Point, Rect, Size(..))
import GreyBgF(changeBg)
--import LayoutRequest(LayoutRequest)
import Loops(loopLeftF)
import Message(message) --Message(..),
import NullF
--import SpEither(mapFilterSP)
import Xtypes
import Utils

data BMevents = BMNormal | BMInverted | BMClick  deriving (BMevents -> BMevents -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BMevents -> BMevents -> Bool
$c/= :: BMevents -> BMevents -> Bool
== :: BMevents -> BMevents -> Bool
$c== :: BMevents -> BMevents -> Bool
Eq, Eq BMevents
BMevents -> BMevents -> Bool
BMevents -> BMevents -> Ordering
BMevents -> BMevents -> BMevents
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BMevents -> BMevents -> BMevents
$cmin :: BMevents -> BMevents -> BMevents
max :: BMevents -> BMevents -> BMevents
$cmax :: BMevents -> BMevents -> BMevents
>= :: BMevents -> BMevents -> Bool
$c>= :: BMevents -> BMevents -> Bool
> :: BMevents -> BMevents -> Bool
$c> :: BMevents -> BMevents -> Bool
<= :: BMevents -> BMevents -> Bool
$c<= :: BMevents -> BMevents -> Bool
< :: BMevents -> BMevents -> Bool
$c< :: BMevents -> BMevents -> Bool
compare :: BMevents -> BMevents -> Ordering
$ccompare :: BMevents -> BMevents -> Ordering
Ord, Int -> BMevents -> ShowS
[BMevents] -> ShowS
BMevents -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BMevents] -> ShowS
$cshowList :: [BMevents] -> ShowS
show :: BMevents -> String
$cshow :: BMevents -> String
showsPrec :: Int -> BMevents -> ShowS
$cshowsPrec :: Int -> BMevents -> ShowS
Show)

buttonGroupF :: [(ModState, String)] -> F (Either BMevents b) c -> F b c
buttonGroupF     = forall {b} {c}.
ButtonParams
-> [(ModState, String)] -> F (Either BMevents b) c -> F b c
buttonGroupF' ButtonParams
cmdButton
menuButtonGroupF :: F (Either BMevents b) c -> F b c
menuButtonGroupF = forall {b} {c}.
ButtonParams
-> [(ModState, String)] -> F (Either BMevents b) c -> F b c
buttonGroupF' ButtonParams
menuButton []

buttonGroupF' :: ButtonParams
-> [(ModState, String)] -> F (Either BMevents b) c -> F b c
buttonGroupF' ButtonParams
bp [(ModState, String)]
keys F (Either BMevents b) c
f = forall a b c. F (Either a b) (Either a c) -> F b c
loopLeftF (forall {c} {d}.
ButtonParams
-> [(ModState, String)]
-> F c d
-> F (Either Bool c) (Either BMevents d)
buttonMachineF' ButtonParams
bp [(ModState, String)]
keys F (Either BMevents b) c
f forall c d e. F c d -> (e -> c) -> F e d
>=^< forall a b. b -> Either a b
Right)

--buttonMachineF = buttonMachineF' cmdButton

buttonMachineF' :: ButtonParams
-> [(ModState, String)]
-> F c d
-> F (Either Bool c) (Either BMevents d)
buttonMachineF' ButtonParams
bp [(ModState, String)]
keys = forall {a} {b} {c} {d}.
[FRequest] -> K a b -> F c d -> F (Either a c) (Either b d)
groupF [] (forall a b. String -> K a b -> K a b
changeBg String
bgColor (ButtonParams -> [(ModState, String)] -> K Bool BMevents
buttonK ButtonParams
bp [(ModState, String)]
keys))

data ButtonParams =
  BP { ButtonParams -> ModState
modstate :: ModState,
       ButtonParams -> Button
mbutton :: Button,
       ButtonParams -> Button -> ModState -> K Bool BMevents
bmachine :: Button -> ModState -> K Bool BMevents }

elbMask :: [EventMask]
elbMask = [EventMask
EnterWindowMask, EventMask
LeaveWindowMask, EventMask
ButtonPressMask, EventMask
ButtonReleaseMask]

cmdButton :: ButtonParams
cmdButton =
  BP { modstate :: ModState
modstate = [],
       mbutton :: Button
mbutton = Int -> Button
Button Int
1,
       bmachine :: Button -> ModState -> K Bool BMevents
bmachine = Button -> ModState -> K Bool BMevents
buttonMachine }

menuButton :: ButtonParams
menuButton =
  BP { modstate :: ModState
modstate = [],
       mbutton :: Button
mbutton = Int -> Button
Button Int
1, -- not used
       bmachine :: Button -> ModState -> K Bool BMevents
bmachine = Button -> ModState -> K Bool BMevents
mbuttonMachine }

buttonMachine :: Button -> ModState -> K Bool BMevents
buttonMachine Button
mousebutton ModState
modstate =
    forall {i} {o}. [EventMask] -> K i o -> K i o
setEventMask [] forall a b. (a -> b) -> a -> b
$
    forall {i} {o}. XCommand -> K i o -> K i o
xcommandK (Bool -> Button -> ModState -> [EventMask] -> XCommand
GrabButton Bool
False Button
mousebutton ModState
modstate [EventMask]
grabbedMask) forall a b. (a -> b) -> a -> b
$
    BMevents -> K Bool BMevents
bm BMevents
BMNormal
  where
    grabbedMask :: [EventMask]
grabbedMask = [EventMask]
elbMask
    switch :: BMevents -> K Bool BMevents
switch BMevents
newme = forall {ho} {hi}. KCommand ho -> K hi ho -> K hi ho
putK (forall a b. b -> Message a b
High BMevents
newme) (BMevents -> K Bool BMevents
bm BMevents
newme)
    pressed :: K Bool BMevents
pressed = BMevents -> K Bool BMevents
switch BMevents
BMInverted
    normal :: K Bool BMevents
normal = BMevents -> K Bool BMevents
switch BMevents
BMNormal
    clicked :: K Bool BMevents
clicked = forall {b} {a}. [KCommand b] -> K a b -> K a b
putsK [forall a b. b -> Message a b
High BMevents
BMNormal, forall a b. b -> Message a b
High BMevents
BMClick] (BMevents -> K Bool BMevents
bm BMevents
BMNormal)
    changeMode :: K Bool BMevents
changeMode =
	-- switch to menu button mode
	forall {i} {o}. XCommand -> K i o -> K i o
xcommandK (Button -> ModState -> XCommand
UngrabButton Button
mousebutton ModState
modstate) forall a b. (a -> b) -> a -> b
$
	Button -> ModState -> K Bool BMevents
mbuttonMachine Button
mousebutton ModState
modstate
    bm :: BMevents -> K Bool BMevents
bm BMevents
me =
      let nochange :: K Bool BMevents
nochange = BMevents -> K Bool BMevents
bm BMevents
me
      in forall {hi} {ho}. Cont (K hi ho) (KEvent hi)
getK forall a b. (a -> b) -> a -> b
$ \KEvent Bool
msg ->
	 case KEvent Bool
msg of
	   Low (XEvt XEvent
event) ->
	     case XEvent
event of
	       (EnterNotify {detail :: XEvent -> Detail
detail=Detail
d}) | Detail
d forall a. Eq a => a -> a -> Bool
/= Detail
NotifyInferior -> K Bool BMevents
pressed
	       (LeaveNotify {detail :: XEvent -> Detail
detail=Detail
d}) | Detail
d forall a. Eq a => a -> a -> Bool
/= Detail
NotifyInferior -> K Bool BMevents
normal
	       (ButtonEvent {state :: XEvent -> ModState
state=ModState
s,type' :: XEvent -> Pressed
type'=Pressed
Pressed,button :: XEvent -> Button
button=Button
b})
	         | Button
b forall a. Eq a => a -> a -> Bool
== Button
mousebutton Bool -> Bool -> Bool
&& ModState
modstate forall {t1 :: * -> *} {t2 :: * -> *} {a}.
(Foldable t1, Foldable t2, Eq a) =>
t1 a -> t2 a -> Bool
`issubset` ModState
s -> K Bool BMevents
pressed
	       (ButtonEvent {type' :: XEvent -> Pressed
type'=Pressed
Released,button :: XEvent -> Button
button=Button
b})
	         | Button
b forall a. Eq a => a -> a -> Bool
== Button
mousebutton -> if BMevents
me forall a. Eq a => a -> a -> Bool
== BMevents
BMInverted
	                               then K Bool BMevents
clicked
				       else K Bool BMevents
nochange
	       (MenuPopupMode Bool
True) -> K Bool BMevents
changeMode
	       XEvent
_ -> K Bool BMevents
nochange
	   High Bool
True -> K Bool BMevents
changeMode
	   KEvent Bool
_ -> K Bool BMevents
nochange

mbuttonMachine :: Button -> ModState -> K Bool BMevents
mbuttonMachine Button
mousebutton ModState
modstate =
    forall {i} {o}. [EventMask] -> K i o -> K i o
setEventMask [EventMask]
elbMask forall a b. (a -> b) -> a -> b
$
    K Bool BMevents
loop
  where
    loop :: K Bool BMevents
loop = 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 Bool BMevents
low Bool -> K Bool BMevents
high
    out :: BMevents -> K Bool BMevents
out BMevents
e = forall {ho} {hi}. KCommand ho -> K hi ho -> K hi ho
putK (forall a b. b -> Message a b
High BMevents
e) K Bool BMevents
loop
    normal :: K Bool BMevents
normal = BMevents -> K Bool BMevents
out BMevents
BMNormal
    pressed :: K Bool BMevents
pressed = BMevents -> K Bool BMevents
out BMevents
BMInverted
    clicked :: K Bool BMevents
clicked = BMevents -> K Bool BMevents
out BMevents
BMClick

    low :: FResponse -> K Bool BMevents
low (XEvt XEvent
ev) = XEvent -> K Bool BMevents
event XEvent
ev
    low FResponse
_ = K Bool BMevents
loop
    event :: XEvent -> K Bool BMevents
event (ButtonEvent {type' :: XEvent -> Pressed
type'=Pressed
Released}) = K Bool BMevents
clicked
    event (EnterNotify {}) = K Bool BMevents
pressed
    event (LeaveNotify {}) = K Bool BMevents
normal
    event (MenuPopupMode Bool
False) = Button -> ModState -> K Bool BMevents
buttonMachine Button
mousebutton ModState
modstate
    event XEvent
_ = K Bool BMevents
loop

    high :: Bool -> K Bool BMevents
high Bool
False = Button -> ModState -> K Bool BMevents
buttonMachine Button
mousebutton ModState
modstate
    high Bool
_ = K Bool BMevents
loop

buttonK :: ButtonParams -> [(ModState, KeySym)] -> K Bool BMevents
buttonK :: ButtonParams -> [(ModState, String)] -> K Bool BMevents
buttonK (BP {mbutton :: ButtonParams -> Button
mbutton=Button
mbutton, modstate :: ButtonParams -> ModState
modstate=ModState
modstate, bmachine :: ButtonParams -> Button -> ModState -> K Bool BMevents
bmachine=Button -> ModState -> K Bool BMevents
bmachine }) [(ModState, String)]
keys =
    forall {i} {o}. [XCommand] -> K i o -> K i o
xcommandsK [XCommand]
initcmds forall a b. (a -> b) -> a -> b
$ Button -> ModState -> K Bool BMevents
bmachine Button
mbutton ModState
modstate
  where
    initcmds :: [XCommand]
initcmds = [XCommand]
transinit forall a. [a] -> [a] -> [a]
++ [XCommand
MeButtonMachine]

    transinit :: [XCommand]
transinit =
	if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ModState, String)]
keys
	then []
	else [(XEvent -> Maybe XEvent) -> [EventMask] -> XCommand
TranslateEvent XEvent -> Maybe XEvent
tobutton [EventMask
KeyPressMask, EventMask
KeyReleaseMask]]

    tobutton :: XEvent -> Maybe XEvent
tobutton (KeyEvent Int
t Point
p1 Point
p2 ModState
s Pressed
pressed KeyCode
_ String
ks String
_) | (ModState
s, String
ks) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(ModState, String)]
keys =
	forall a. a -> Maybe a
Just (Int -> Point -> Point -> ModState -> Pressed -> Button -> XEvent
ButtonEvent Int
t Point
p1 Point
p2 ModState
modstate Pressed
pressed Button
mbutton)
    tobutton XEvent
_ = forall a. Maybe a
Nothing

setEventMask :: [EventMask] -> K i o -> K i o
setEventMask [EventMask]
mask = forall {i} {o}. XCommand -> K i o -> K i o
xcommandK ([WindowAttributes] -> XCommand
ChangeWindowAttributes [[EventMask] -> WindowAttributes
CWEventMask [EventMask]
mask])