{-# LANGUAGE CPP #-}
module MenuBarF(
#ifndef __NHC__
menuF,menuBarF,MenuBar(..),Menu(..),MenuItem'(..),
Item,item,item',key,itemValue,
cmdItem,subMenuItem,toggleItem,sepItem,
radioGroupItem,dynRadioGroupItem,
delayedSubMenuItem,
MenuItem(..),menu,Transl(..),idT,compT,
menuIcon
#endif
) where
import Control.Monad((<=<))
import AllFudgets hiding (menuF)
import HbcUtils(mapFst)
import DynRadioGroupF
import KeyGfx
#ifndef __NHC__
#include "../hsrc/exists.h"
tr :: a2 -> a2
tr a2
x = forall {a1} {a2}. Show a1 => [Char] -> a1 -> a2 -> a2
ctrace [Char]
"menubar" a2
x a2
x
Menu a
menu = forall a. Eq a => LayoutDir -> Menu a -> F a a
menuListF LayoutDir
Horizontal Menu a
menu
Menu a
menu = forall a. Eq a => LayoutDir -> Menu a -> F a a
menuListF LayoutDir
Vertical Menu a
menu
type a = Menu a
type a = [MenuItem' a]
type Keys = [(ModState,KeySym)]
type a = Item (MenuItem a)
data Item a = Item a Gfx Keys
item :: a -> a -> Item a
item a
i = forall {a} {a}. Graphic a => Keys -> a -> a -> Item a
item' [] a
i
item' :: Keys -> a -> a -> Item a
item' Keys
k a
i a
g = forall a. a -> Gfx -> Keys -> Item a
Item a
i (forall a. Graphic a => a -> Gfx
G a
g) Keys
k
itemValue :: Item a -> a
itemValue (Item a
a Gfx
_ Keys
_) = a
a
key :: Item a -> [Char] -> Item a
key (Item a
a Gfx
g Keys
_) [Char]
k = forall a. a -> Gfx -> Keys -> Item a
Item a
a (forall a. Graphic a => a -> Gfx
G (forall {a} {lbl}. Graphic a => a -> [Char] -> Drawing lbl Gfx
keyGfx Gfx
g [Char]
k)) [([Modifiers
metaKey],[Char]
k)]
instance Graphic (Item a) where
measureGraphicK :: forall (k :: * -> * -> *) i o.
FudgetIO k =>
Item a -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK (Item a
_ Gfx
gfx Keys
_) = forall a (k :: * -> * -> *) i o.
(Graphic a, FudgetIO k) =>
a -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK Gfx
gfx
instance Eq a => Eq (Item a) where
Item a
x Gfx
_ Keys
_ == :: Item a -> Item a -> Bool
== Item a
y Gfx
_ Keys
_ = a
xforall a. Eq a => a -> a -> Bool
==a
y
cmdItem :: p -> a -> Item (MenuItem p)
cmdItem p
x = forall {a} {a}. Graphic a => a -> a -> Item a
item forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> MenuItem a
MenuCommand forall a b. (a -> b) -> a -> b
$ p
x
toggleItem :: Transl Bool a -> Bool -> a -> Item (MenuItem a)
toggleItem Transl Bool a
tr = forall {a} {a}. Graphic a => a -> a -> Item a
item forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Transl Bool a -> Bool -> MenuItem a
MenuToggle Transl Bool a
tr
Transl b a
tr = forall {a} {a}. Graphic a => a -> a -> Item a
item forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Eq b => Bool -> Transl b a -> Menu b -> MenuItem a
SubMenu Bool
False Transl b a
tr
Transl b a
tr = forall {a} {a}. Graphic a => a -> a -> Item a
item forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Eq b => Bool -> Transl b a -> Menu b -> MenuItem a
SubMenu Bool
True Transl b a
tr
radioGroupItem :: Transl a a -> [Item a] -> a -> a -> Item (MenuItem a)
radioGroupItem Transl a a
tr [Item a]
items = forall {a} {a}. Graphic a => a -> a -> Item a
item forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Eq b => Transl b a -> [Item b] -> b -> MenuItem a
MenuRadioGroup Transl a a
tr [Item a]
items
dynRadioGroupItem :: Transl ([Item a], a) a -> [Item a] -> a -> a -> Item (MenuItem a)
dynRadioGroupItem Transl ([Item a], a) a
tr [Item a]
items = forall {a} {a}. Graphic a => a -> a -> Item a
item forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b.
Eq b =>
Transl ([Item b], b) a -> [Item b] -> b -> MenuItem a
MenuDynRadioGroup Transl ([Item a], a) a
tr [Item a]
items
sepItem :: Item (MenuItem a)
sepItem = forall {a} {a}. Graphic a => a -> a -> Item a
item forall a. MenuItem a
MenuLabel (forall {lbl} {leaf}.
Distance -> Drawing lbl leaf -> Drawing lbl leaf
padD Distance
3 forall a b. (a -> b) -> a -> b
$ forall {a} {lbl}. Graphic a => a -> Drawing lbl Gfx
g forall a b. (a -> b) -> a -> b
$ Distance -> FlexibleDrawing
hFiller Distance
1)
data a
= MenuCommand a
| (Transl Bool a) Bool
| EXISTS(b) (Eq EQV(b))MenuRadioGroup (Transl EQV(b) a) [Item EQV(b)] EQV(b)
| EXISTS(b) (Eq EQV(b))MenuDynRadioGroup (Transl ([Item EQV(b)],EQV(b)) a) [Item EQV(b)] EQV(b)
| EXISTS(b) (Eq EQV(b))SubMenu Bool (Transl EQV(b) a) (Menu EQV(b))
|
Transl b a
t = forall a b. Eq b => Bool -> Transl b a -> Menu b -> MenuItem a
SubMenu Bool
False Transl b a
t
type MMsg a = Either MenuState a
type MF a b = F (MMsg a) (MMsg b)
data Transl l g = Transl (l->g) (g->Maybe l)
menuItemF :: Eq a => LayoutDir -> MenuItem' a -> MF a a
LayoutDir
dir (Item MenuItem a
item Gfx
gfx Keys
keys) =
case MenuItem a
item of
MenuCommand a
a -> forall {c} {b} {a} {a}.
Transl c b -> F c c -> F (Either a b) (Either a b)
translF (forall {a}. Eq a => a -> Transl Click a
click a
a) (forall {lbl}.
Graphic lbl =>
Customiser (ButtonF lbl) -> lbl -> F Click Click
buttonF' (forall xxx. HasAlign xxx => Alignment -> Customiser xxx
setAlign Alignment
aLeft forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {c}. (HasKeys c, HasFontSpec c) => c -> c
pm) Gfx
gfx)
MenuToggle Transl Bool a
tr Bool
init ->
forall {c} {b} {a} {a}.
Transl c b -> F c c -> F (Either a b) (Either a b)
translF Transl Bool a
tr (forall {b}. F b b
delayItFforall {a1} {b} {a2}. F a1 b -> F a2 a1 -> F a2 b
>==<forall {hi} {ho}. [hi] -> F hi ho -> F hi ho
startupF [Bool
init] (forall lbl.
Graphic lbl =>
Customiser ToggleButtonF -> lbl -> F Bool Bool
toggleButtonF' forall {c}. (HasKeys c, HasFontSpec c) => c -> c
pm Gfx
gfx))
MenuRadioGroup Transl b a
tr [Item b]
items b
init ->
forall {c} {b} {a} {a}.
Transl c b -> F c c -> F (Either a b) (Either a b)
translF Transl b a
tr (forall {b}. F b b
delayItFforall {a1} {b} {a2}. F a1 b -> F a2 a1 -> F a2 b
>==<Gfx
gfx forall {p} {c} {d}. Graphic p => p -> F c d -> F c d
`labAboveF` forall lbl alt.
(Graphic lbl, Eq alt) =>
Customiser RadioGroupF -> [(alt, lbl)] -> alt -> F alt alt
radioGroupF' Customiser RadioGroupF
pm [(b, Gfx)]
alts b
init)
where alts :: [(b, Gfx)]
alts = [(b
a,Gfx
g)|Item b
a Gfx
g Keys
_<-[Item b]
items]
pm :: Customiser RadioGroupF
pm = forall {xxx} {a}.
(HasFontSpec xxx, Show a, FontGen a) =>
a -> Customiser xxx
setFont [Char]
menuFont forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Placer -> Customiser RadioGroupF
setPlacer (Distance -> Placer
verticalP' Distance
0)
MenuDynRadioGroup Transl ([Item b], b) a
tr [Item b]
items b
init ->
forall {c} {b} {a} {a}.
Transl c b -> F c c -> F (Either a b) (Either a b)
translF Transl ([(b, Gfx)], b) a
tr' (forall {b}. F b b
delayItFforall {a1} {b} {a2}. F a1 b -> F a2 a1 -> F a2 b
>==<Gfx
gfx forall {p} {c} {d}. Graphic p => p -> F c d -> F c d
`labAboveF` forall {lbl} {b}.
(Graphic lbl, Eq b) =>
Customiser RadioGroupF
-> [(b, lbl)] -> b -> F ([(b, lbl)], b) ([(b, lbl)], b)
dynRadioGroupF' Customiser RadioGroupF
pm [(b, Gfx)]
alts b
init)
where alts :: [(b, Gfx)]
alts = [(b
a,Gfx
g)|Item b
a Gfx
g Keys
_<-[Item b]
items]
pm :: Customiser RadioGroupF
pm = forall {xxx} {a}.
(HasFontSpec xxx, Show a, FontGen a) =>
a -> Customiser xxx
setFont [Char]
menuFont forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Placer -> Customiser RadioGroupF
setPlacer (Distance -> Placer
verticalP' Distance
0)
tr' :: Transl ([(b, Gfx)], b) a
tr' = forall {b} {g} {l}. Transl b g -> Transl l b -> Transl l g
compT Transl ([Item b], b) a
tr forall {a} {b}. Transl ([(a, Gfx)], b) ([Item a], b)
dynRadioT
dynRadioT :: Transl ([(a, Gfx)], b) ([Item a], b)
dynRadioT = forall l g. (l -> g) -> (g -> Maybe l) -> Transl l g
Transl forall {a} {b}. ([(a, Gfx)], b) -> ([Item a], b)
f forall {a} {b}. ([Item a], b) -> Maybe ([(a, Gfx)], b)
g
where
f :: ([(a, Gfx)], b) -> ([Item a], b)
f ([(a, Gfx)]
alts,b
alt) = ([forall a. a -> Gfx -> Keys -> Item a
Item a
i Gfx
g []|(a
i,Gfx
g)<-[(a, Gfx)]
alts],b
alt)
g :: ([Item a], b) -> Maybe ([(a, Gfx)], b)
g ([Item a]
items,b
alt) = forall a. a -> Maybe a
Just ([(a
a,Gfx
g)|Item a
a Gfx
g Keys
_<-[Item a]
items],b
alt)
SubMenu Bool
d Transl b a
tr Menu b
m -> forall {b} {a1} {a2} {a}.
Transl b a1
-> F (Either a2 b) (Either a b) -> F (Either a2 a1) (Either a a1)
translMenuF Transl b a
tr (forall a. Bool -> LayoutDir -> Gfx -> F (MMsg a) a -> MF a a
btnMenuF Bool
d LayoutDir
dir Gfx
gfx ( forall a. Eq a => Menu a -> F (MMsg a) a
subMenuF Menu b
m))
MenuItem a
MenuLabel -> forall {p} {e} {d}. Graphic p => p -> F e d
graphicsLabelF Gfx
gfx
where
pm :: c -> c
pm c
x = forall xxx. HasKeys xxx => Keys -> Customiser xxx
setKeys Keys
keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {xxx} {a}.
(HasFontSpec xxx, Show a, FontGen a) =>
a -> Customiser xxx
setFont [Char]
menuFont forall a b. (a -> b) -> a -> b
$ c
x
btnMenuF :: Bool -> LayoutDir -> Gfx -> F (MMsg a) a -> MF a a
Bool
delayed LayoutDir
dir Gfx
gfx F (MMsg a) a
mF =
forall {b1} {a} {b2}.
Graphic b1 =>
Bool
-> LayoutDir
-> [Char]
-> b1
-> [(a, Keys)]
-> F (Either MenuState b2) a
-> F (Either MenuState (Either b1 b2)) (Either MenuState a)
buttonMenuF' Bool
delayed LayoutDir
dir [Char]
menuFont forall {lbl}. Drawing lbl Gfx
agfx [] F (MMsg a) a
mF forall 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. b -> Either a b
Right
where
agfx :: Drawing lbl Gfx
agfx = forall {lbl} {leaf}.
Distance -> [Drawing lbl leaf] -> Drawing lbl leaf
hboxcD' Distance
3 [forall {a} {lbl}. Graphic a => a -> Drawing lbl Gfx
g Gfx
gfx,forall {a} {lbl}. Graphic a => a -> Drawing lbl Gfx
g FixedDrawing
menuIcon]
translF :: Transl c b -> F c c -> F (Either a b) (Either a b)
translF (Transl c -> b
f b -> Maybe c
g) F c c
fud =
forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> b
f forall a b e. (a -> b) -> F e a -> F e b
>^=< F c c
fud forall c d e. F c d -> SP e c -> F e d
>=^^< forall {t} {b}. (t -> Maybe b) -> SP t b
mapFilterSP (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) b -> Maybe c
g)
(Transl b -> a1
f a1 -> Maybe b
g) F (Either a2 b) (Either a b)
fud =
forall {t1} {a} {t2} {b}.
(t1 -> a) -> (t2 -> b) -> Either t1 t2 -> Either a b
mapEither forall a. a -> a
id b -> a1
f forall a b e. (a -> b) -> F e a -> F e b
>^=< F (Either a2 b) (Either a b)
fud forall c d e. F c d -> SP e c -> F e d
>=^^< forall {a1} {b} {a2}. SP a1 b -> SP (Either a2 a1) (Either a2 b)
idLeftSP (forall {t} {b}. (t -> Maybe b) -> SP t b
mapFilterSP a1 -> Maybe b
g)
click :: a -> Transl Click a
click a
a = forall l g. (l -> g) -> (g -> Maybe l) -> Transl l g
Transl (forall a b. a -> b -> a
const a
a) (\a
b->if a
aforall a. Eq a => a -> a -> Bool
==a
b then forall a. a -> Maybe a
Just Click
Click else forall a. Maybe a
Nothing)
idT :: Transl g g
idT = forall l g. (l -> g) -> (g -> Maybe l) -> Transl l g
Transl forall a. a -> a
id (forall a b. a -> b -> a
const forall a. Maybe a
Nothing)
compT :: Transl b g -> Transl l b -> Transl l g
compT (Transl b -> g
f1 g -> Maybe b
g1) (Transl l -> b
f2 b -> Maybe l
g2) = forall l g. (l -> g) -> (g -> Maybe l) -> Transl l g
Transl (b -> g
f1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. l -> b
f2) (b -> Maybe l
g2 forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< g -> Maybe b
g1)
menuListF :: Eq a => LayoutDir -> Menu a -> F a a
LayoutDir
dir Menu a
menu = forall {b} {a} {d}.
[(b, Keys)] -> F (Either a b) (Either MenuState d) -> F b d
grabberF (forall a. Menu a -> [(a, Keys)]
menuKeys Menu a
menu) forall a b. (a -> b) -> a -> b
$ forall a. Eq a => LayoutDir -> Menu a -> MF a a
menuListF' LayoutDir
dir Menu a
menu
where
menuKeys :: Menu a -> [(a,Keys)]
menuKeys :: forall a. Menu a -> [(a, Keys)]
menuKeys = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a}. Item (MenuItem a) -> [(a, Keys)]
itemKeys
itemKeys :: Item (MenuItem a) -> [(a, Keys)]
itemKeys (Item MenuItem a
m Gfx
_ Keys
keys) =
case MenuItem a
m of
SubMenu Bool
_ (Transl b -> a
f a -> Maybe b
_) Menu b
menu -> forall {t} {a} {b}. (t -> a) -> [(t, b)] -> [(a, b)]
mapFst b -> a
f (forall a. Menu a -> [(a, Keys)]
menuKeys Menu b
menu)
MenuRadioGroup (Transl b -> a
f a -> Maybe b
_) [Item b]
items b
init ->
[(b -> a
f b
a,Keys
ks)|Item b
a Gfx
_ Keys
ks<-[Item b]
items]
MenuItem a
_ -> []
subMenuF :: Eq a => Menu a -> F (MMsg a) a
Menu a
menu = forall {a1} {b}. SP (Either a1 b) b
filterRightSP forall a b e. SP a b -> F e a -> F e b
>^^=< forall a. Eq a => LayoutDir -> Menu a -> MF a a
menuListF' LayoutDir
Vertical Menu a
menu
menuListF' :: Eq a => LayoutDir -> Menu a -> MF a a
LayoutDir
dir Menu a
m =
forall a b c. F (Either a b) (Either a c) -> F b c
loopLeftF forall a b. (a -> b) -> a -> b
$
forall {t} {b}. (t -> [b]) -> SP t b
concatMapSP forall {a} {b} {b}. (a, Either b b) -> [Either (a, b) (Either b b)]
post forall a b e. SP a b -> F e a -> F e b
>^^=< forall a b. Placer -> F a b -> F a b
placerF (LayoutDir -> Distance -> Placer
linearP LayoutDir
dir Distance
0) (forall a b c. Eq a => [(a, F b c)] -> F (a, b) (a, c)
listF [(Distance, F (MMsg a) (MMsg a))]
nms)
forall c d e. F c d -> SP e c -> F e d
>=^^< forall {t} {b}. (t -> [b]) -> SP t b
concatMapSP forall {a} {b}.
Either (Distance, a) (Either a b) -> [(Distance, Either a b)]
pre
where
nms :: [(Distance, F (MMsg a) (MMsg a))]
nms = [(Distance
i,forall a. Eq a => LayoutDir -> MenuItem' a -> MF a a
menuItemF LayoutDir
dir MenuItem' a
e) | (Distance
i,MenuItem' a
e) <- forall a. Distance -> [a] -> [(Distance, a)]
number Distance
0 Menu a
m]
ns :: [Distance]
ns = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Distance, F (MMsg a) (MMsg a))]
nms
post :: (a, Either b b) -> [Either (a, b) (Either b b)]
post (a
i,Right b
x) = [forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right b
x]
post (a
i,Left b
b) = [forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left b
b,forall a b. a -> Either a b
Left (a
i,b
b)]
pre :: Either (Distance, a) (Either a b) -> [(Distance, Either a b)]
pre (Right (Right b
x)) = forall {a1} {a2}. Show a1 => [Char] -> a1 -> a2 -> a2
ctrace [Char]
"menubar" [Char]
"got input" [(Distance
i,forall a b. b -> Either a b
Right b
x) | Distance
i<-[Distance]
ns]
pre (Right (Left a
b)) = [(Distance
i,forall a b. a -> Either a b
Left a
b) | Distance
i<-[Distance]
ns]
pre (Left (Distance
j,a
b)) = [(Distance
i,forall a b. a -> Either a b
Left a
b) | Distance
i<-[Distance]
ns, Distance
iforall a. Eq a => a -> a -> Bool
/=Distance
j]
delayItF :: F b b
delayItF = forall {b}. F b b
idF
=
Size -> [DrawCommand] -> FixedDrawing
FixD Size
12 [
Rect -> DrawCommand
DrawRectangle (Distance -> Distance -> Distance -> Distance -> Rect
rR Distance
1 Distance
0 Distance
8 Distance
10),
Line -> DrawCommand
DrawLine (Distance -> Distance -> Distance -> Distance -> Line
lL Distance
4 Distance
3 Distance
6 Distance
3),
Line -> DrawCommand
DrawLine (Distance -> Distance -> Distance -> Distance -> Line
lL Distance
4 Distance
5 Distance
6 Distance
5),
Line -> DrawCommand
DrawLine (Distance -> Distance -> Distance -> Distance -> Line
lL Distance
4 Distance
7 Distance
6 Distance
7),
Line -> DrawCommand
DrawLine (Distance -> Distance -> Distance -> Distance -> Line
lL Distance
3 Distance
11 Distance
10 Distance
11),
Line -> DrawCommand
DrawLine (Distance -> Distance -> Distance -> Distance -> Line
lL Distance
10 Distance
2 Distance
10 Distance
11)]
#endif