{-# 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 MonadUtil((@@))
import DynRadioGroupF
import KeyGfx

#ifndef __NHC__
#include "../hsrc/exists.h"

tr :: a2 -> a2
tr a2
x = [Char] -> a2 -> a2 -> a2
forall a1 a2. Show a1 => [Char] -> a1 -> a2 -> a2
ctrace [Char]
"menubar" a2
x a2
x

--- Top level calls, eta expanded because of the monomorphism restriction
menuBarF :: Menu a -> F a a
menuBarF Menu a
menu = LayoutDir -> Menu a -> F a a
forall a. Eq a => LayoutDir -> Menu a -> F a a
menuListF LayoutDir
Horizontal Menu a
menu
menuF :: Menu a -> F a a
menuF Menu a
menu =  LayoutDir -> Menu a -> F a a
forall a. Eq a => LayoutDir -> Menu a -> F a a
menuListF LayoutDir
Vertical Menu a
menu

type MenuBar a = Menu a
type Menu a = [MenuItem' a]
type Keys = [(ModState,KeySym)]

type MenuItem' a = Item (MenuItem a)

data Item a = Item a Gfx Keys
item :: a -> a -> Item a
item a
i = Keys -> a -> a -> Item a
forall a a. Graphic a => Keys -> a -> a -> Item a
item' [] a
i -- eta expanded because of the monomorphism restriction
item' :: Keys -> a -> a -> Item a
item' Keys
k a
i a
g = a -> Gfx -> Keys -> Item a
forall a. a -> Gfx -> Keys -> Item a
Item a
i (a -> Gfx
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 = a -> Gfx -> Keys -> Item a
forall a. a -> Gfx -> Keys -> Item a
Item a
a (Drawing Any Gfx -> Gfx
forall a. Graphic a => a -> Gfx
G (Gfx -> [Char] -> Drawing Any Gfx
forall a lbl. Graphic a => a -> [Char] -> Drawing lbl Gfx
keyGfx Gfx
g [Char]
k)) [([Modifiers
metaKey],[Char]
k)]
			-- this creates some unnecessary nested G (G ..)

instance Graphic (Item a) where
  measureGraphicK :: Item a -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK (Item a
_ Gfx
gfx Keys
_) = Gfx -> GCtx -> Cont (k i o) MeasuredGraphics
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
xa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
y

cmdItem :: a -> a -> Item (MenuItem a)
cmdItem a
x = MenuItem a -> a -> Item (MenuItem a)
forall a a. Graphic a => a -> a -> Item a
item (MenuItem a -> a -> Item (MenuItem a))
-> (a -> MenuItem a) -> a -> a -> Item (MenuItem a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> MenuItem a
forall a. a -> MenuItem a
MenuCommand (a -> a -> Item (MenuItem a)) -> a -> a -> Item (MenuItem a)
forall a b. (a -> b) -> a -> b
$ a
x -- eta expanded because of the monomorphism restriction
toggleItem :: Transl Bool a -> Bool -> a -> Item (MenuItem a)
toggleItem Transl Bool a
tr = MenuItem a -> a -> Item (MenuItem a)
forall a a. Graphic a => a -> a -> Item a
item (MenuItem a -> a -> Item (MenuItem a))
-> (Bool -> MenuItem a) -> Bool -> a -> Item (MenuItem a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transl Bool a -> Bool -> MenuItem a
forall a. Transl Bool a -> Bool -> MenuItem a
MenuToggle Transl Bool a
tr
subMenuItem :: Transl b a -> Menu b -> a -> Item (MenuItem a)
subMenuItem Transl b a
tr = MenuItem a -> a -> Item (MenuItem a)
forall a a. Graphic a => a -> a -> Item a
item (MenuItem a -> a -> Item (MenuItem a))
-> (Menu b -> MenuItem a) -> Menu b -> a -> Item (MenuItem a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Transl b a -> Menu b -> MenuItem a
forall a b. Eq b => Bool -> Transl b a -> Menu b -> MenuItem a
SubMenu Bool
False Transl b a
tr
delayedSubMenuItem :: Transl b a -> Menu b -> a -> Item (MenuItem a)
delayedSubMenuItem Transl b a
tr = MenuItem a -> a -> Item (MenuItem a)
forall a a. Graphic a => a -> a -> Item a
item (MenuItem a -> a -> Item (MenuItem a))
-> (Menu b -> MenuItem a) -> Menu b -> a -> Item (MenuItem a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Transl b a -> Menu b -> MenuItem a
forall a b. Eq b => Bool -> Transl b a -> Menu b -> MenuItem a
SubMenu Bool
True Transl b a
tr
radioGroupItem :: Transl b a -> [Item b] -> b -> a -> Item (MenuItem a)
radioGroupItem Transl b a
tr [Item b]
items = MenuItem a -> a -> Item (MenuItem a)
forall a a. Graphic a => a -> a -> Item a
item (MenuItem a -> a -> Item (MenuItem a))
-> (b -> MenuItem a) -> b -> a -> Item (MenuItem a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transl b a -> [Item b] -> b -> MenuItem a
forall a b. Eq b => Transl b a -> [Item b] -> b -> MenuItem a
MenuRadioGroup Transl b a
tr [Item b]
items
dynRadioGroupItem :: Transl ([Item b], b) a -> [Item b] -> b -> a -> Item (MenuItem a)
dynRadioGroupItem Transl ([Item b], b) a
tr [Item b]
items = MenuItem a -> a -> Item (MenuItem a)
forall a a. Graphic a => a -> a -> Item a
item (MenuItem a -> a -> Item (MenuItem a))
-> (b -> MenuItem a) -> b -> a -> Item (MenuItem a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transl ([Item b], b) a -> [Item b] -> b -> MenuItem a
forall a b.
Eq b =>
Transl ([Item b], b) a -> [Item b] -> b -> MenuItem a
MenuDynRadioGroup Transl ([Item b], b) a
tr [Item b]
items
sepItem :: Item (MenuItem a)
sepItem = MenuItem a -> Drawing Any Gfx -> Item (MenuItem a)
forall a a. Graphic a => a -> a -> Item a
item MenuItem a
forall a. MenuItem a
MenuLabel (Distance -> Drawing Any Gfx -> Drawing Any Gfx
forall lbl leaf. Distance -> Drawing lbl leaf -> Drawing lbl leaf
padD Distance
3 (Drawing Any Gfx -> Drawing Any Gfx)
-> Drawing Any Gfx -> Drawing Any Gfx
forall a b. (a -> b) -> a -> b
$ FlexibleDrawing -> Drawing Any Gfx
forall a lbl. Graphic a => a -> Drawing lbl Gfx
g (FlexibleDrawing -> Drawing Any Gfx)
-> FlexibleDrawing -> Drawing Any Gfx
forall a b. (a -> b) -> a -> b
$ Distance -> FlexibleDrawing
hFiller Distance
1)

data MenuItem a
  = MenuCommand a
  | MenuToggle (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))
  | MenuLabel

-- eta expanded because of the monomorphism restriction:
menu :: Transl b a -> Menu b -> MenuItem a
menu Transl b a
t = Bool -> Transl b a -> Menu b -> MenuItem a
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
menuItemF :: LayoutDir -> MenuItem' a -> MF a a
menuItemF LayoutDir
dir (Item MenuItem a
item Gfx
gfx Keys
keys) =
  case MenuItem a
item of
    MenuCommand a
a -> Transl Click a -> F Click Click -> MF a a
forall c b b a. Transl c b -> F c c -> F (Either b b) (Either a b)
translF (a -> Transl Click a
forall a. Eq a => a -> Transl Click a
click a
a) (Customiser (ButtonF Gfx) -> Gfx -> F Click Click
forall lbl.
Graphic lbl =>
Customiser (ButtonF lbl) -> lbl -> F Click Click
buttonF' (Alignment -> Customiser (ButtonF Gfx)
forall xxx. HasAlign xxx => Alignment -> Customiser xxx
setAlign Alignment
aLeft Customiser (ButtonF Gfx)
-> Customiser (ButtonF Gfx) -> Customiser (ButtonF Gfx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Customiser (ButtonF Gfx)
forall c. (HasKeys c, HasFontSpec c) => c -> c
pm) Gfx
gfx)
    MenuToggle Transl Bool a
tr Bool
init ->
	Transl Bool a -> F Bool Bool -> MF a a
forall c b b a. Transl c b -> F c c -> F (Either b b) (Either a b)
translF Transl Bool a
tr (F Bool Bool
forall b. F b b
delayItFF Bool Bool -> F Bool Bool -> F Bool Bool
forall a1 b a2. F a1 b -> F a2 a1 -> F a2 b
>==<[Bool] -> F Bool Bool -> F Bool Bool
forall hi ho. [hi] -> F hi ho -> F hi ho
startupF [Bool
init] (Customiser ToggleButtonF -> Gfx -> F Bool Bool
forall lbl.
Graphic lbl =>
Customiser ToggleButtonF -> lbl -> F Bool Bool
toggleButtonF' Customiser ToggleButtonF
forall c. (HasKeys c, HasFontSpec c) => c -> c
pm Gfx
gfx))
    MenuRadioGroup Transl b a
tr [Item b]
items b
init ->
	Transl b a -> F b b -> MF a a
forall c b b a. Transl c b -> F c c -> F (Either b b) (Either a b)
translF Transl b a
tr (F b b
forall b. F b b
delayItFF b b -> F b b -> F b b
forall a1 b a2. F a1 b -> F a2 a1 -> F a2 b
>==<Gfx
gfx Gfx -> F b b -> F b b
forall g c d. Graphic g => g -> F c d -> F c d
`labAboveF` Customiser RadioGroupF -> [(b, Gfx)] -> b -> F b b
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 = [Char] -> Customiser RadioGroupF
forall xxx a.
(HasFontSpec xxx, Show a, FontGen a) =>
a -> Customiser xxx
setFont [Char]
menuFont Customiser RadioGroupF
-> Customiser RadioGroupF -> Customiser RadioGroupF
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
		 Placer -> Customiser RadioGroupF
setPlacer (Distance -> Placer
verticalP' Distance
0) -- (the default is verticalLeftP' 0)
    MenuDynRadioGroup Transl ([Item b], b) a
tr [Item b]
items b
init ->
	Transl ([(b, Gfx)], b) a
-> F ([(b, Gfx)], b) ([(b, Gfx)], b) -> MF a a
forall c b b a. Transl c b -> F c c -> F (Either b b) (Either a b)
translF Transl ([(b, Gfx)], b) a
tr' (F ([(b, Gfx)], b) ([(b, Gfx)], b)
forall b. F b b
delayItFF ([(b, Gfx)], b) ([(b, Gfx)], b)
-> F ([(b, Gfx)], b) ([(b, Gfx)], b)
-> F ([(b, Gfx)], b) ([(b, Gfx)], b)
forall a1 b a2. F a1 b -> F a2 a1 -> F a2 b
>==<Gfx
gfx Gfx
-> F ([(b, Gfx)], b) ([(b, Gfx)], b)
-> F ([(b, Gfx)], b) ([(b, Gfx)], b)
forall g c d. Graphic g => g -> F c d -> F c d
`labAboveF` Customiser RadioGroupF
-> [(b, Gfx)] -> b -> F ([(b, Gfx)], b) ([(b, Gfx)], b)
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 = [Char] -> Customiser RadioGroupF
forall xxx a.
(HasFontSpec xxx, Show a, FontGen a) =>
a -> Customiser xxx
setFont [Char]
menuFont Customiser RadioGroupF
-> Customiser RadioGroupF -> Customiser RadioGroupF
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
		 Placer -> Customiser RadioGroupF
setPlacer (Distance -> Placer
verticalP' Distance
0) -- (the default is verticalLeftP' 0)
	    tr' :: Transl ([(b, Gfx)], b) a
tr' = Transl ([Item b], b) a
-> Transl ([(b, Gfx)], b) ([Item b], b) -> Transl ([(b, Gfx)], b) a
forall l g c. Transl l g -> Transl c l -> Transl c g
compT Transl ([Item b], b) a
tr Transl ([(b, Gfx)], b) ([Item b], b)
forall a b. Transl ([(a, Gfx)], b) ([Item a], b)
dynRadioT
	    dynRadioT :: Transl ([(a, Gfx)], b) ([Item a], b)
dynRadioT = (([(a, Gfx)], b) -> ([Item a], b))
-> (([Item a], b) -> Maybe ([(a, Gfx)], b))
-> Transl ([(a, Gfx)], b) ([Item a], b)
forall l g. (l -> g) -> (g -> Maybe l) -> Transl l g
Transl ([(a, Gfx)], b) -> ([Item a], b)
forall a b. ([(a, Gfx)], b) -> ([Item a], b)
f ([Item a], b) -> Maybe ([(a, Gfx)], b)
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) = ([a -> Gfx -> Keys -> Item a
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) = ([(a, Gfx)], b) -> Maybe ([(a, Gfx)], b)
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  -> Transl b a -> F (Either MenuState b) (Either MenuState b) -> MF a a
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 (Bool
-> LayoutDir
-> Gfx
-> F (Either MenuState b) b
-> F (Either MenuState b) (Either MenuState b)
forall a. Bool -> LayoutDir -> Gfx -> F (MMsg a) a -> MF a a
btnMenuF Bool
d LayoutDir
dir Gfx
gfx ({-delayF' d $-} Menu b -> F (Either MenuState b) b
forall a. Eq a => Menu a -> F (MMsg a) a
subMenuF Menu b
m))
    MenuItem a
MenuLabel     -> Gfx -> MF a a
forall a e d. Graphic a => a -> F e d
graphicsLabelF Gfx
gfx
--    MenuDelayed item' -> delayF' $ menuItemF dir (Item item' gfx keys)
  where
    --pm = setKeys keys . setFont menuFont
    -- becuase of the mononorphism restriction:
    pm :: c -> c
pm c
x = Keys -> c -> c
forall xxx. HasKeys xxx => Keys -> Customiser xxx
setKeys Keys
keys (c -> c) -> (c -> c) -> c -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> c -> c
forall xxx a.
(HasFontSpec xxx, Show a, FontGen a) =>
a -> Customiser xxx
setFont [Char]
menuFont (c -> c) -> c -> c
forall a b. (a -> b) -> a -> b
$ c
x

{-
    delayF' delayed =
      if delayed
      then delayF''
      else id

    delayF'' fud =
      if argFlag "teemenu" False
      then delayF fud >==< idRightF (teeF show "menuItemF: ")
      else delayF fud
-}

btnMenuF :: Bool -> LayoutDir -> Gfx -> F (MMsg a) a -> MF a a
btnMenuF :: Bool -> LayoutDir -> Gfx -> F (MMsg a) a -> MF a a
btnMenuF Bool
delayed LayoutDir
dir Gfx
gfx F (MMsg a) a
mF =
    Bool
-> LayoutDir
-> [Char]
-> Drawing Any Gfx
-> [(a, Keys)]
-> F (MMsg a) a
-> F (Either MenuState (Either (Drawing Any Gfx) a)) (MMsg a)
forall lbl a b.
Graphic lbl =>
Bool
-> LayoutDir
-> [Char]
-> lbl
-> [(a, Keys)]
-> F (Either MenuState b) a
-> F (Either MenuState (Either lbl b)) (Either MenuState a)
buttonMenuF' Bool
delayed LayoutDir
dir [Char]
menuFont Drawing Any Gfx
forall lbl. Drawing lbl Gfx
agfx [] F (MMsg a) a
mF F (Either MenuState (Either (Drawing Any Gfx) a)) (MMsg a)
-> (MMsg a -> Either MenuState (Either (Drawing Any Gfx) a))
-> MF a a
forall c d e. F c d -> (e -> c) -> F e d
>=^< (MenuState -> MenuState)
-> (a -> Either (Drawing Any Gfx) a)
-> MMsg a
-> Either MenuState (Either (Drawing Any Gfx) a)
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 (Drawing Any Gfx) a
forall a b. b -> Either a b
Right
  where
    agfx :: Drawing lbl Gfx
agfx = Distance -> [Drawing lbl Gfx] -> Drawing lbl Gfx
forall lbl leaf. Distance -> [Drawing lbl leaf] -> Drawing lbl leaf
hboxcD' Distance
3 [Gfx -> Drawing lbl Gfx
forall a lbl. Graphic a => a -> Drawing lbl Gfx
g Gfx
gfx,FixedDrawing -> Drawing lbl Gfx
forall a lbl. Graphic a => a -> Drawing lbl Gfx
g FixedDrawing
menuIcon]

translF :: Transl c b -> F c c -> F (Either b b) (Either a b)
translF (Transl c -> b
f b -> Maybe c
g) F c c
fud =
  b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> (c -> b) -> c -> Either a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> b
f (c -> Either a b) -> F c c -> F c (Either a b)
forall a b e. (a -> b) -> F e a -> F e b
>^=< F c c
fud F c (Either a b)
-> SP (Either b b) c -> F (Either b b) (Either a b)
forall c d e. F c d -> SP e c -> F e d
>=^^< (Either b b -> Maybe c) -> SP (Either b b) c
forall t b. (t -> Maybe b) -> SP t b
mapFilterSP ((b -> Maybe c) -> (b -> Maybe c) -> Either b b -> Maybe c
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe c -> b -> Maybe c
forall a b. a -> b -> a
const Maybe c
forall a. Maybe a
Nothing) b -> Maybe c
g)

translMenuF :: Transl b a1
-> F (Either a2 b) (Either a b) -> F (Either a2 a1) (Either a a1)
translMenuF (Transl b -> a1
f a1 -> Maybe b
g) F (Either a2 b) (Either a b)
fud =
  (a -> a) -> (b -> a1) -> Either a b -> Either a a1
forall t1 a t2 b.
(t1 -> a) -> (t2 -> b) -> Either t1 t2 -> Either a b
mapEither a -> a
forall a. a -> a
id b -> a1
f (Either a b -> Either a a1)
-> F (Either a2 b) (Either a b) -> F (Either a2 b) (Either a a1)
forall a b e. (a -> b) -> F e a -> F e b
>^=< F (Either a2 b) (Either a b)
fud F (Either a2 b) (Either a a1)
-> SP (Either a2 a1) (Either a2 b)
-> F (Either a2 a1) (Either a a1)
forall c d e. F c d -> SP e c -> F e d
>=^^< SP a1 b -> SP (Either a2 a1) (Either a2 b)
forall a1 b a2. SP a1 b -> SP (Either a2 a1) (Either a2 b)
idLeftSP ((a1 -> Maybe b) -> SP a1 b
forall t b. (t -> Maybe b) -> SP t b
mapFilterSP a1 -> Maybe b
g)

click :: a -> Transl Click a
click a
a = (Click -> a) -> (a -> Maybe Click) -> Transl Click a
forall l g. (l -> g) -> (g -> Maybe l) -> Transl l g
Transl (a -> Click -> a
forall a b. a -> b -> a
const a
a) (\a
b->if a
aa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
b then Click -> Maybe Click
forall a. a -> Maybe a
Just Click
Click else Maybe Click
forall a. Maybe a
Nothing)
idT :: Transl b b
idT = (b -> b) -> (b -> Maybe b) -> Transl b b
forall l g. (l -> g) -> (g -> Maybe l) -> Transl l g
Transl b -> b
forall a. a -> a
id (Maybe b -> b -> Maybe b
forall a b. a -> b -> a
const Maybe b
forall a. Maybe a
Nothing)
--idT = Transl id Just -- why not this?
compT :: Transl l g -> Transl c l -> Transl c g
compT (Transl l -> g
f1 g -> Maybe l
g1) (Transl c -> l
f2 l -> Maybe c
g2) = (c -> g) -> (g -> Maybe c) -> Transl c g
forall l g. (l -> g) -> (g -> Maybe l) -> Transl l g
Transl (l -> g
f1 (l -> g) -> (c -> l) -> c -> g
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> l
f2) (l -> Maybe c
g2 (l -> Maybe c) -> (g -> Maybe l) -> g -> Maybe c
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< g -> Maybe l
g1)

-- There should be only one grabberF outside the top level menu.
menuListF :: Eq a => LayoutDir -> Menu a -> F a a
menuListF :: LayoutDir -> Menu a -> F a a
menuListF LayoutDir
dir Menu a
menu = [(a, Keys)] -> F (Either MenuState a) (Either MenuState a) -> F a a
forall a1 a2 d.
[(a1, Keys)] -> F (Either a2 a1) (Either MenuState d) -> F a1 d
grabberF (Menu a -> [(a, Keys)]
forall a. Menu a -> [(a, Keys)]
menuKeys Menu a
menu) (F (Either MenuState a) (Either MenuState a) -> F a a)
-> F (Either MenuState a) (Either MenuState a) -> F a a
forall a b. (a -> b) -> a -> b
$ LayoutDir -> Menu a -> F (Either MenuState a) (Either MenuState a)
forall a. Eq a => LayoutDir -> Menu a -> MF a a
menuListF' LayoutDir
dir Menu a
menu
  where
    menuKeys :: Menu a -> [(a,Keys)]
    menuKeys :: Menu a -> [(a, Keys)]
menuKeys = (Item (MenuItem a) -> [(a, Keys)]) -> Menu a -> [(a, Keys)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Item (MenuItem a) -> [(a, Keys)]
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 -> (b -> a) -> [(b, Keys)] -> [(a, Keys)]
forall t a b. (t -> a) -> [(t, b)] -> [(a, b)]
mapFst b -> a
f (Menu b -> [(b, Keys)]
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]
	  --MenuCommand cmd -> [(cmd,keys)]
	  --MenuToggle (Transl f _) init -> [(f init,keys)] -- hmm
	  MenuItem a
_ -> []

subMenuF :: Eq a => Menu a -> F (MMsg a) a
subMenuF :: Menu a -> F (MMsg a) a
subMenuF Menu a
menu = SP (MMsg a) a
forall a1 b. SP (Either a1 b) b
filterRightSP SP (MMsg a) a -> F (MMsg a) (MMsg a) -> F (MMsg a) a
forall a b e. SP a b -> F e a -> F e b
>^^=< LayoutDir -> Menu a -> F (MMsg a) (MMsg a)
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
menuListF' :: LayoutDir -> Menu a -> MF a a
menuListF' LayoutDir
dir Menu a
m =
    F (Either (Distance, MenuState) (Either MenuState a))
  (Either (Distance, MenuState) (Either MenuState a))
-> MF a a
forall a b c. F (Either a b) (Either a c) -> F b c
loopLeftF (F (Either (Distance, MenuState) (Either MenuState a))
   (Either (Distance, MenuState) (Either MenuState a))
 -> MF a a)
-> F (Either (Distance, MenuState) (Either MenuState a))
     (Either (Distance, MenuState) (Either MenuState a))
-> MF a a
forall a b. (a -> b) -> a -> b
$
    ((Distance, Either MenuState a)
 -> [Either (Distance, MenuState) (Either MenuState a)])
-> SP
     (Distance, Either MenuState a)
     (Either (Distance, MenuState) (Either MenuState a))
forall t b. (t -> [b]) -> SP t b
concatMapSP (Distance, Either MenuState a)
-> [Either (Distance, MenuState) (Either MenuState a)]
forall a b b. (a, Either b b) -> [Either (a, b) (Either b b)]
post SP
  (Distance, Either MenuState a)
  (Either (Distance, MenuState) (Either MenuState a))
-> F (Distance, Either MenuState a) (Distance, Either MenuState a)
-> F (Distance, Either MenuState a)
     (Either (Distance, MenuState) (Either MenuState a))
forall a b e. SP a b -> F e a -> F e b
>^^=< Placer
-> F (Distance, Either MenuState a) (Distance, Either MenuState a)
-> F (Distance, Either MenuState a) (Distance, Either MenuState a)
forall a b. Placer -> F a b -> F a b
placerF (LayoutDir -> Distance -> Placer
linearP LayoutDir
dir Distance
0) ([(Distance, MF a a)]
-> F (Distance, Either MenuState a) (Distance, Either MenuState a)
forall a b c. Eq a => [(a, F b c)] -> F (a, b) (a, c)
listF [(Distance, MF a a)]
nms)
    F (Distance, Either MenuState a)
  (Either (Distance, MenuState) (Either MenuState a))
-> SP
     (Either (Distance, MenuState) (Either MenuState a))
     (Distance, Either MenuState a)
-> F (Either (Distance, MenuState) (Either MenuState a))
     (Either (Distance, MenuState) (Either MenuState a))
forall c d e. F c d -> SP e c -> F e d
>=^^< (Either (Distance, MenuState) (Either MenuState a)
 -> [(Distance, Either MenuState a)])
-> SP
     (Either (Distance, MenuState) (Either MenuState a))
     (Distance, Either MenuState a)
forall t b. (t -> [b]) -> SP t b
concatMapSP Either (Distance, MenuState) (Either MenuState a)
-> [(Distance, Either MenuState a)]
forall a b.
Either (Distance, a) (Either a b) -> [(Distance, Either a b)]
pre
  where
    nms :: [(Distance, MF a a)]
nms = [(Distance
i,LayoutDir -> MenuItem' a -> MF a a
forall a. Eq a => LayoutDir -> MenuItem' a -> MF a a
menuItemF LayoutDir
dir MenuItem' a
e) | (Distance
i,MenuItem' a
e) <- Distance -> Menu a -> [(Distance, MenuItem' a)]
forall a. Distance -> [a] -> [(Distance, a)]
number Distance
0 Menu a
m]
    ns :: [Distance]
ns = ((Distance, MF a a) -> Distance)
-> [(Distance, MF a a)] -> [Distance]
forall a b. (a -> b) -> [a] -> [b]
map (Distance, MF a a) -> Distance
forall a b. (a, b) -> a
fst [(Distance, MF a a)]
nms
    post :: (a, Either b b) -> [Either (a, b) (Either b b)]
post (a
i,Right b
x) = [Either b b -> Either (a, b) (Either b b)
forall a b. b -> Either a b
Right (Either b b -> Either (a, b) (Either b b))
-> Either b b -> Either (a, b) (Either b b)
forall a b. (a -> b) -> a -> b
$ b -> Either b b
forall a b. b -> Either a b
Right b
x]
    post (a
i,Left b
b) = [Either b b -> Either (a, b) (Either b b)
forall a b. b -> Either a b
Right (Either b b -> Either (a, b) (Either b b))
-> Either b b -> Either (a, b) (Either b b)
forall a b. (a -> b) -> a -> b
$ b -> Either b b
forall a b. a -> Either a b
Left b
b,(a, b) -> Either (a, b) (Either 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)) = [Char]
-> [Char] -> [(Distance, Either a b)] -> [(Distance, Either a b)]
forall a1 a2. Show a1 => [Char] -> a1 -> a2 -> a2
ctrace [Char]
"menubar" [Char]
"got input" [(Distance
i,b -> Either a b
forall a b. b -> Either a b
Right b
x) | Distance
i<-[Distance]
ns]
    pre (Right (Left a
b)) =  [(Distance
i,a -> Either a b
forall a b. a -> Either a b
Left a
b) | Distance
i<-[Distance]
ns]
    pre (Left (Distance
j,a
b)) = [(Distance
i,a -> Either a b
forall a b. a -> Either a b
Left a
b) | Distance
i<-[Distance]
ns, Distance
iDistance -> Distance -> Bool
forall a. Eq a => a -> a -> Bool
/=Distance
j]

delayItF :: F b b
delayItF = F b b
forall b. F b b
idF
{-
delayItF = loopThroughRightF (absF idleSP) timerF
  where
    idleSP = getSP $ either (const idleSP) delaySP
    delaySP x = putSP (Left (Just (0,delay))) $ waitSP x
    waitSP x = getSP $ either doneSP waitSP
      where doneSP _ = putSP (Left Nothing) $ putSP (Right x) idleSP

    delay = argReadKey "delay" 200
-}

--- temporary hack:
{-
--subMenuF gfx mF = menuPopupF mF >==< throughF (buttonF agfx>=^^<nullSP)
menuPopupF mF =
    post >^=<
    inputPopupF "Menu" (inputMsg>^=<mF>=^^<filterRightSP) Nothing
     >=^< pre
  where
    pre cmd = (Nothing,Just cmd)
    post = snd
-}

menuIcon :: FixedDrawing
menuIcon =
  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