{-# 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)

#include "defaults.h"

newtype RadioGroupF = Pars [Pars]
data Pars = LabelInside Bool | FontSpec FontSpec | Placer Placer

setPlacer :: Placer -> Customiser RadioGroupF
parameter(Placer)
parameter_instance(LabelInside,RadioGroupF)
parameter_instance(FontSpec,RadioGroupF)

radioGroupF :: [(alt, lbl)] -> alt -> F alt alt
radioGroupF [(alt, lbl)]
lbl = forall lbl alt.
(Graphic lbl, Eq alt) =>
Customiser RadioGroupF -> [(alt, lbl)] -> alt -> F alt alt
radioGroupF' forall a. Customiser a
standard [(alt, lbl)]
lbl

radioGroupF' :: (Graphic lbl,Eq alt )=> Customiser RadioGroupF -> [(alt,lbl)] -> alt -> F alt alt
radioGroupF' :: forall lbl alt.
(Graphic lbl, Eq alt) =>
Customiser RadioGroupF -> [(alt, lbl)] -> alt -> F alt alt
radioGroupF' Customiser RadioGroupF
pmod [(alt, lbl)]
alts alt
startalt = 
    forall {d} {p1} {p}.
(Eq d, Graphic p1, Show p, FontGen p) =>
Placer -> Bool -> p -> [(d, p1)] -> d -> F d d
radioF Placer
placer Bool
inside FontSpec
font [(alt, lbl)]
alts alt
startalt
  where
    placer :: Placer
placer  = RadioGroupF -> Placer
getPlacer RadioGroupF
ps
    inside :: Bool
inside  = forall xxx. HasLabelInside xxx => xxx -> Bool
getLabelInside RadioGroupF
ps
    font :: FontSpec
font    = forall xxx. HasFontSpec xxx => xxx -> FontSpec
getFontSpec RadioGroupF
ps
    ps :: RadioGroupF
ps      = Customiser RadioGroupF
pmod RadioGroupF
ps0
    ps0 :: RadioGroupF
ps0     = [Pars] -> RadioGroupF
Pars [Bool -> Pars
LabelInside Bool
False,FontSpec -> Pars
FontSpec (forall {a}. (Show a, FontGen a) => a -> FontSpec
fontSpec FontName
buttonFont),Placer -> Pars
Placer Placer
placer0]
    placer0 :: Placer
placer0 = Distance -> Placer
verticalLeftP' Distance
0