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 :: Double
-> Int
-> a
-> ColorSpec
-> a
-> [(ModState, KeySym)]
-> e
-> F e Click
oldButtonF Double
halign Int
margin a
fname ColorSpec
bg a
fg [(ModState, KeySym)]
keys e
lbl =
    SP (Either GfxFEvent Click) Click
forall a1 b. SP (Either a1 b) b
filterRightSP SP (Either GfxFEvent Click) Click
-> F e (Either GfxFEvent Click) -> F e Click
forall a b e. SP a b -> F e a -> F e b
>^^=< [(ModState, KeySym)]
-> F e GfxFEvent -> F e (Either GfxFEvent Click)
forall b1 b2.
[(ModState, KeySym)] -> F b1 b2 -> F b1 (Either b2 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 = Spacer -> Drawing lbl Gfx -> Drawing lbl Gfx
forall lbl leaf. Spacer -> Drawing lbl leaf -> Drawing lbl leaf
spacedD Spacer
spacer (Drawing lbl Gfx -> Drawing lbl Gfx)
-> (e -> Drawing lbl Gfx) -> e -> Drawing lbl Gfx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Drawing lbl Gfx
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 = Drawing lbl Gfx
-> GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx)
forall (xxx :: * -> *) a.
HasInitDisp xxx =>
a -> Customiser (xxx a)
setInitDisp (e -> Drawing lbl Gfx
forall lbl. e -> Drawing lbl Gfx
lblD e
lbl) (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
Static (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
. ColorSpec
-> GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx)
forall xxx. HasBgColorSpec xxx => ColorSpec -> Customiser xxx
setBgColorSpec ColorSpec
bg (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
.
		       a -> GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx)
forall xxx a.
(HasFontSpec xxx, Show a, FontGen a) =>
a -> Customiser xxx
setFont a
fname (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
. a -> GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx)
forall xxx a.
(HasFgColorSpec xxx, Show a, ColorGen a) =>
a -> Customiser xxx
setFgColor a
fg (GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx))
-> GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx)
forall a b. (a -> b) -> a -> b
$ GraphicsF (Drawing lbl Gfx)
x
              spacer :: Spacer
spacer = Int -> Spacer
marginS Int
margin Spacer -> Spacer -> Spacer
`compS` Double -> Double -> Spacer
alignFixedS' Double
halign Double
aCenter
	  in Customiser (GraphicsF (Drawing Any Gfx))
-> F (GfxFCmd (Drawing Any Gfx)) GfxFEvent
forall gfx.
Graphic gfx =>
Customiser (GraphicsF gfx) -> F (GfxFCmd gfx) GfxFEvent
graphicsDispF' Customiser (GraphicsF (Drawing Any Gfx))
forall lbl.
GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx)
custom F (GfxFCmd (Drawing Any Gfx)) GfxFEvent
-> (e -> GfxFCmd (Drawing Any Gfx)) -> F e GfxFEvent
forall c d e. F c d -> (e -> c) -> F e d
>=^< Drawing Any Gfx -> GfxFCmd (Drawing Any Gfx)
forall gfx a. gfx -> GfxCommand [a] gfx
replaceAllGfx (Drawing Any Gfx -> GfxFCmd (Drawing Any Gfx))
-> (e -> Drawing Any Gfx) -> e -> GfxFCmd (Drawing Any Gfx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Drawing Any Gfx
forall lbl. e -> Drawing lbl Gfx
lblD