DToggleButtonF

{-# LANGUAGE CPP #-}
module DToggleButtonF(
  HasLabelInside(..),ToggleButtonF,
  toggleButtonF,toggleButtonF' --,toggleButtonF''
  ) where
import FDefaults
import ToggleButtonF(oldToggleButtonF')
import NullF(F)
import Xtypes
import Defaults(buttonFont)
import Graphic
import GCAttrs --(FontSpec,fontSpec) -- + instances

{-
HBC uses "cpp -C -traditional" which causes all the  to be left behind
when the macro definitions are processed. That is why the definitions
are inside a comment.







  
-}

newtype ToggleButtonF = Pars [Pars]
data Pars = LabelInside Bool | FontSpec FontSpec | Keys [(ModState, KeySym)]

class HasLabelInside xxx where {    setLabelInside :: (Bool) -> Customiser xxx;     getLabelInside :: xxx -> (Bool);     getLabelInsideMaybe :: xxx -> Maybe (Bool);     getLabelInside = fromMaybe (error "get LabelInside: missing default") . getLabelInsideMaybe }

instance HasLabelInside (ToggleButtonF) where {  setLabelInside p (Pars ps) = Pars (LabelInside p:ps);   getLabelInsideMaybe (Pars ps) = getparMaybe (\x->case x of LabelInside p -> Just p; _-> Nothing) ps }
instance HasFontSpec (ToggleButtonF) where {  setFontSpec p (Pars ps) = Pars (FontSpec p:ps);   getFontSpecMaybe (Pars ps) = getparMaybe (\x->case x of FontSpec p -> Just p; _-> Nothing) ps }
instance HasKeys (ToggleButtonF) where {  setKeys p (Pars ps) = Pars (Keys p:ps);   getKeysMaybe (Pars ps) = getparMaybe (\x->case x of Keys p -> Just p; _-> Nothing) ps }

toggleButtonF lbl = toggleButtonF' standard lbl

toggleButtonF' :: (Graphic lbl)=> Customiser ToggleButtonF -> lbl -> F Bool Bool
toggleButtonF' pmod lbl = 
    oldToggleButtonF' inside font keys lbl
  where
    inside = getLabelInside ps
    font   = getFontSpec ps
    keys   = getKeys ps
    ps     = pmod ps0
    ps0    =  Pars [LabelInside False,FontSpec (fontSpec buttonFont), Keys []]