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

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