{-# LANGUAGE CPP #-} module DRadioF( RadioGroupF,radioGroupF,radioGroupF', setPlacer ) where import FDefaults import RadioF(radioF) import DToggleButtonF(HasLabelInside(..)) import NullF(F) import LayoutRequest(Placer) import Spacers() -- synonym Distance, for hbc import Placers2(verticalLeftP') --import Xtypes import ResourceIds() -- synonym FontName, for hbc import Defaults(buttonFont) import Graphic import GCAttrs --(FontSpec,fontSpec) {- 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 RadioGroupF = Pars [Pars] data Pars = LabelInside Bool | FontSpec FontSpec | Placer Placer setPlacer p = cust (\ (Pars ps) -> Pars (Placer p:ps)); getPlacer (Pars ps) = getpar (\x->case x of Placer p -> Just p; _-> Nothing) ps; getPlacerMaybe (Pars ps) = getparMaybe (\x->case x of Placer p -> Just p; _-> Nothing) ps instance HasLabelInside (RadioGroupF) 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 (RadioGroupF) where { setFontSpec p (Pars ps) = Pars (FontSpec p:ps); getFontSpecMaybe (Pars ps) = getparMaybe (\x->case x of FontSpec p -> Just p; _-> Nothing) ps } radioGroupF lbl = radioGroupF' standard lbl radioGroupF' :: (Graphic lbl,Eq alt )=> Customiser RadioGroupF -> [(alt,lbl)] -> alt -> F alt alt radioGroupF' pmod alts startalt = radioF placer inside font alts startalt where placer = getPlacer ps inside = getLabelInside ps font = getFontSpec ps ps = pmod ps0 ps0 = Pars [LabelInside False,FontSpec (fontSpec buttonFont),Placer placer0] placer0 = verticalLeftP' 0