module MenuButtonF(menuButtonF,menuLabelF) where
import ButtonGroupF
import CompOps((>^^=<),(>=^<))
import SpEither(filterRightSP)
import SerCompF(idRightF)
import Defaults(inputFg,inputBg)
--import EitherUtils(stripEither)
import PushButtonF(Click(..))
import ResourceIds(FontName(..))--ColorName(..),
import Spacers(sepS)
import GraphicsF
import FDefaults
import DrawingUtils(g,boxD,spacedD)--fgD,fontD,
import Graphic
import Drawing(DPath)
import Geometry(pP)
import Fudget
import Sizing(Sizing(..))
import GCAttrs()

menuButtonF :: Graphic lbl => FontName -> lbl -> F lbl Click
menuButtonF :: forall lbl. Graphic lbl => FontName -> lbl -> F lbl Click
menuButtonF FontName
fname lbl
label =
    forall {a1} {b}. SP (Either a1 b) b
filterRightSP forall a b e. SP a b -> F e a -> F e b
>^^=< forall {b} {c}. F (Either BMevents b) c -> F b c
menuButtonGroupF (forall a b c. F a b -> F (Either a c) (Either b c)
idRightF F (Either Bool lbl) (GfxEvent DPath)
lblF forall c d e. F c d -> (e -> c) -> F e d
>=^< forall {b}. Either BMevents b -> Either (Either Bool b) Click
prep)
  where
    lblF :: F (Either Bool lbl) (GfxEvent DPath)
lblF = forall lbl.
Graphic lbl =>
FontName -> lbl -> F (Either Bool lbl) (GfxEvent DPath)
menuLabelF FontName
fname lbl
label
    toDisp :: a -> Either a b
toDisp = forall a b. a -> Either a b
Left
    through :: b -> Either a b
through = forall a b. b -> Either a b
Right
    prep :: Either BMevents b -> Either (Either Bool b) Click
prep (Left BMevents
BMNormal) = forall a b. a -> Either a b
toDisp (forall a b. a -> Either a b
Left Bool
False)
    prep (Left BMevents
BMInverted) = forall a b. a -> Either a b
toDisp (forall a b. a -> Either a b
Left Bool
True)
    prep (Left BMevents
BMClick) = forall {b} {a}. b -> Either a b
through Click
Click
    prep (Right b
e) = forall a b. a -> Either a b
toDisp (forall a b. b -> Either a b
Right b
e)

menuLabelF :: Graphic lbl => FontName -> lbl -> F (Either Bool lbl) (GfxEvent DPath)
menuLabelF :: forall lbl.
Graphic lbl =>
FontName -> lbl -> F (Either Bool lbl) (GfxEvent DPath)
menuLabelF FontName
fname lbl
label =
    forall {lbl}. F (GfxFCmd (Drawing lbl Gfx)) (GfxEvent DPath)
lblF forall c d e. F c d -> (e -> c) -> F e d
>=^< forall {a} {a} {lbl}.
Graphic a =>
Either Bool a -> GfxCommand [a] (Drawing lbl Gfx)
pre
  where
    lblF :: F (GfxFCmd (Drawing lbl Gfx)) (GfxEvent DPath)
lblF = forall gfx.
Graphic gfx =>
Customiser (GraphicsF gfx) -> F (GfxFCmd gfx) (GfxEvent DPath)
graphicsDispF' forall {lbl}.
GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx)
custom
    custom :: GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx)
custom = forall {xxx} {p}.
(HasBgColorSpec xxx, Show p, ColorGen p) =>
p -> Customiser xxx
setBgColor FontName
inputBg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (xxx :: * -> *) a.
HasInitDisp xxx =>
a -> Customiser (xxx a)
setInitDisp (forall {a} {lbl}. Graphic a => a -> Drawing lbl Gfx
lblD lbl
label) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
	     forall {gfx}. [GfxEventMask] -> Customiser (GraphicsF gfx)
setGfxEventMask [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall xxx. HasSizing xxx => Sizing -> Customiser xxx
setSizing Sizing
Dynamic forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall xxx. HasBorderWidth xxx => Int -> Customiser xxx
setBorderWidth Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
.
	     forall {xxx} {p}.
(HasFgColorSpec xxx, Show p, ColorGen p) =>
p -> Customiser xxx
setFgColor FontName
inputFg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {xxx} {a}.
(HasFontSpec xxx, Show a, FontGen a) =>
a -> Customiser xxx
setFont FontName
fname
    lblD :: a -> Drawing lbl Gfx
lblD a
label = forall {lbl} {leaf}. [Drawing lbl leaf] -> Drawing lbl leaf
boxD [forall {lbl} {leaf}. Spacer -> Drawing lbl leaf -> Drawing lbl leaf
spacedD (Size -> Spacer
sepS (Int -> Int -> Size
pP Int
3 Int
1)) forall a b. (a -> b) -> a -> b
$ forall {a} {lbl}. Graphic a => a -> Drawing lbl Gfx
g a
label]

    pre :: Either Bool a -> GfxCommand [a] (Drawing lbl Gfx)
pre (Left Bool
highlight) = forall {path} {gfx}. path -> Bool -> GfxCommand path gfx
highlightGfx [] Bool
highlight
    pre (Right a
label')  = forall {gfx} {a}. gfx -> GfxCommand [a] gfx
replaceAllGfx (forall {a} {lbl}. Graphic a => a -> Drawing lbl Gfx
lblD a
label')