module ButtonF(oldButtonF) where
import CompOps((>^^=<),(>=^<))
--import Defaults(argKey, bgColor, fgColor)
import GraphicsF(graphicsDispF',replaceAllGfx,setGfxEventMask)
import FDefaults
import Sizing(Sizing(..))
import Drawing() -- instance, for hbc
import Graphic()
--import GCAttrs
--import GCtx(wCreateGCtx,rootGCtx)
import DrawingUtils
--import FDefaults
import PushButtonF
--import Placer(spacerF)
import Spacers(marginS,compS)
import Alignment(aCenter)
import CondLayout(alignFixedS')
import SpEither(filterRightSP)
--import Xtypes
--import NullF()
--import FudgetIO()

-- All this just because of the !@?! monomorphism restriction
--import Fudget(F)
--import GraphicsF(GfxEvent)
--import MeasuredGraphics(DPath)
--import DrawingUtils --(Gfx)

oldButtonF :: Alignment
-> Distance
-> p
-> ColorSpec
-> p
-> [(ModState, KeySym)]
-> e
-> F e Click
oldButtonF Alignment
halign Distance
margin p
fname ColorSpec
bg p
fg [(ModState, KeySym)]
keys e
lbl =
    forall {a1} {b}. SP (Either a1 b) b
filterRightSP forall a b e. SP a b -> F e a -> F e b
>^^=< forall {a} {b}.
[(ModState, KeySym)] -> F a b -> F a (Either b Click)
pushButtonF [(ModState, KeySym)]
keys F e GfxFEvent
lblF
 where
   --lblF :: Graphic lbl => F lbl (GfxEvent DPath) -- the monorestr
   lblF :: F e GfxFEvent
lblF = let --lblD :: Graphic lbl => lbl -> Drawing a Gfx -- the monorestr
	      lblD :: e -> Drawing lbl Gfx
lblD = forall {lbl} {leaf}. Spacer -> Drawing lbl leaf -> Drawing lbl leaf
spacedD Spacer
spacer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {lbl}. Graphic a => a -> Drawing lbl Gfx
g
	      custom :: GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx)
custom GraphicsF (Drawing lbl Gfx)
x = forall (xxx :: * -> *) a.
HasInitDisp xxx =>
a -> Customiser (xxx a)
setInitDisp (forall {lbl}. e -> Drawing lbl Gfx
lblD e
lbl) 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
Static forall b c a. (b -> c) -> (a -> b) -> a -> c
.
		       forall xxx. HasBorderWidth xxx => Distance -> Customiser xxx
setBorderWidth Distance
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall xxx. HasBgColorSpec xxx => ColorSpec -> Customiser xxx
setBgColorSpec ColorSpec
bg forall b c a. (b -> c) -> (a -> b) -> a -> c
.
		       forall {xxx} {a}.
(HasFontSpec xxx, Show a, FontGen a) =>
a -> Customiser xxx
setFont p
fname forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {xxx} {p}.
(HasFgColorSpec xxx, Show p, ColorGen p) =>
p -> Customiser xxx
setFgColor p
fg forall a b. (a -> b) -> a -> b
$ GraphicsF (Drawing lbl Gfx)
x
              spacer :: Spacer
spacer = Distance -> Spacer
marginS Distance
margin Spacer -> Spacer -> Spacer
`compS` Alignment -> Alignment -> Spacer
alignFixedS' Alignment
halign Alignment
aCenter
	  in forall gfx.
Graphic gfx =>
Customiser (GraphicsF gfx) -> F (GfxFCmd gfx) GfxFEvent
graphicsDispF' forall {lbl}.
GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx)
custom forall c d e. F c d -> (e -> c) -> F e d
>=^< forall {gfx} {a}. gfx -> GfxCommand [a] gfx
replaceAllGfx forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {lbl}. e -> Drawing lbl Gfx
lblD