{-# LANGUAGE CPP #-}
module DButtonF(
  ButtonF,buttonF,buttonF',buttonF'',setLabel
  ) where
import FDefaults
import ButtonF(oldButtonF)
--import Fudget
--import Geometry(Rect)
import PushButtonF(Click)
import Xtypes
import Defaults(buttonFont,fgColor,bgColor)
import CmdLineEnv(argKeyList)
import CompOps((>^=<),(>=^^<))
--import Spops(concmapSP)
import SpEither(mapFilterSP)--filterRightSP
import EitherUtils(stripEither)
import SerCompF(idRightF)
import Spacers(Distance(..))
import Alignment(aCenter) --,Alignment(..)
import Graphic
import GCAttrs --(ColorSpec,colorSpec) -- + instances

#include "defaults.h"

newtype ButtonF lbl = Pars [Pars lbl]
data Pars lbl
  = FontSpec FontSpec
  | Keys [(ModState, KeySym)]
  | FgColorSpec ColorSpec
  | BgColorSpec ColorSpec
  | Margin Distance
  | Align Alignment
  | Label lbl

parameter_instance1(FontSpec,ButtonF)
parameter_instance1(Keys,ButtonF)
parameter_instance1(FgColorSpec,ButtonF)
parameter_instance1(BgColorSpec,ButtonF)
parameter_instance1(Margin,ButtonF)
parameter_instance1(Align,ButtonF)
parameterlbl
(Label)

buttonF :: lbl -> F Click Click
buttonF lbl
s = forall {lbl}.
Graphic lbl =>
Customiser (ButtonF lbl) -> lbl -> F Click Click
buttonF' forall a. Customiser a
standard lbl
s
buttonF' :: Customiser (ButtonF lbl) -> lbl -> F Click Click
buttonF' Customiser (ButtonF lbl)
pm lbl
s = forall p a b. PF p a b -> F a b
noPF forall a b. (a -> b) -> a -> b
$ forall lbl.
Graphic lbl =>
Customiser (ButtonF lbl) -> lbl -> PF (ButtonF lbl) Click Click
buttonF'' Customiser (ButtonF lbl)
pm lbl
s

buttonF'' ::
  Graphic lbl => Customiser (ButtonF lbl) -> lbl -> PF (ButtonF lbl) Click Click
buttonF'' :: forall lbl.
Graphic lbl =>
Customiser (ButtonF lbl) -> lbl -> PF (ButtonF lbl) Click Click
buttonF'' Customiser (ButtonF lbl)
pmod lbl
s =
    forall {a}. Either a a -> a
stripEither forall a b e. (a -> b) -> F e a -> F e b
>^=<
    forall a b c. F a b -> F (Either a c) (Either b c)
idRightF (forall {e} {p1} {p2}.
(Graphic e, FontGen p1, Show p1, Show p2, ColorGen p2) =>
Alignment
-> Int
-> p1
-> ColorSpec
-> p2
-> [(ModState, KeySym)]
-> e
-> F e Click
oldButtonF Alignment
align Int
marg FontSpec
font ColorSpec
bg ColorSpec
fg [(ModState, KeySym)]
keys lbl
lbl forall c d e. F c d -> SP e c -> F e d
>=^^< forall {t} {b}. (t -> Maybe b) -> SP t b
mapFilterSP forall {lbl} {a}. (ButtonF lbl -> ButtonF a) -> Maybe a
relbl)
  where
    lbl :: lbl
lbl  = forall {c}. ButtonF c -> c
getLabel ButtonF lbl
ps
    font :: FontSpec
font = forall xxx. HasFontSpec xxx => xxx -> FontSpec
getFontSpec ButtonF lbl
ps
    keys :: [(ModState, KeySym)]
keys = forall xxx. HasKeys xxx => xxx -> [(ModState, KeySym)]
getKeys ButtonF lbl
ps
    ps :: ButtonF lbl
ps   = Customiser (ButtonF lbl)
pmod ButtonF lbl
ps0
    bg :: ColorSpec
bg   = forall xxx. HasBgColorSpec xxx => xxx -> ColorSpec
getBgColorSpec ButtonF lbl
ps
    fg :: ColorSpec
fg   = forall xxx. HasFgColorSpec xxx => xxx -> ColorSpec
getFgColorSpec ButtonF lbl
ps
    marg :: Int
marg = forall xxx. HasMargin xxx => xxx -> Int
getMargin ButtonF lbl
ps
    align :: Alignment
align = forall xxx. HasAlign xxx => xxx -> Alignment
getAlign ButtonF lbl
ps
    ps0 :: ButtonF lbl
ps0  = forall lbl. [Pars lbl] -> ButtonF lbl
Pars [forall lbl. FontSpec -> Pars lbl
FontSpec (forall {a}. (Show a, FontGen a) => a -> FontSpec
fontSpec KeySym
buttonFont), forall lbl. [(ModState, KeySym)] -> Pars lbl
Keys [],forall lbl. Int -> Pars lbl
Margin Int
2,forall lbl. Alignment -> Pars lbl
Align Alignment
aCenter,
		 forall lbl. ColorSpec -> Pars lbl
FgColorSpec ColorSpec
buttonfg, forall lbl. ColorSpec -> Pars lbl
BgColorSpec ColorSpec
buttonbg, forall lbl. lbl -> Pars lbl
Label lbl
s]
    --relbl pmod' = [lbl | let Pars ps'=pmod' (Pars []), Label lbl<-ps']
    relbl :: (ButtonF lbl -> ButtonF a) -> Maybe a
relbl ButtonF lbl -> ButtonF a
pmod' = forall {a}. ButtonF a -> Maybe a
getLabelMaybe (ButtonF lbl -> ButtonF a
pmod' (forall lbl. [Pars lbl] -> ButtonF lbl
Pars []))

buttonbg :: ColorSpec
buttonbg = forall {a}. (Show a, ColorGen a) => a -> ColorSpec
colorSpec (KeySym -> [KeySym] -> [KeySym]
argKeyList KeySym
"buttonbg" [KeySym
bgColor,KeySym
"white"])
buttonfg :: ColorSpec
buttonfg = forall {a}. (Show a, ColorGen a) => a -> ColorSpec
colorSpec (KeySym -> [KeySym] -> [KeySym]
argKeyList KeySym
"buttonfg" [KeySym
fgColor,KeySym
"black"])