module RadioF(radioF, oldRadioGroupF) where
import Spacer(noStretchF)
--import Alignment(Alignment(..))
--import ButtonGroupF
import CompOps((>==<), (>=^<))
import HbcUtils(lookupWithDefault)
--import Fudget
--import Geometry(Point, Rect, Size(..))
import LayoutF(listLF)
--import Placers
import Loops(loopLeftF)
import SerCompF(absF)
import Spops
import EitherUtils(stripEither)
import ToggleButtonF(oldToggleButtonF')
--import Xtypes
import Utils(pair)

radioF :: Placer -> Bool -> p -> [(d, p1)] -> d -> F d d
radioF Placer
placer Bool
inside p
fname [(d, p1)]
alts d
startalt =
  forall {d} {p1} {p}.
(Eq d, Graphic p1, Show p, FontGen p) =>
Placer -> Bool -> p -> [d] -> d -> (d -> p1) -> F d d
oldRadioGroupF Placer
placer Bool
inside p
fname (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(d, p1)]
alts) d
startalt (forall a b. Eq a => [(a, b)] -> b -> a -> b
lookupWithDefault [(d, p1)]
alts (forall a. HasCallStack => [Char] -> a
error [Char]
"radioF"))

oldRadioGroupF :: Placer -> Bool -> p -> [d] -> d -> (d -> p1) -> F d d
oldRadioGroupF Placer
placer Bool
inside p
fname [d]
alts d
startalt d -> p1
show_alt =
    let radioAlts :: F (d, Bool) (d, Bool)
radioAlts = forall {a} {p1} {p}.
(Eq a, Graphic p1, Show p, FontGen p) =>
Placer -> Bool -> p -> [a] -> (a -> p1) -> F (a, Bool) (a, Bool)
radioButtonsF Placer
placer Bool
inside p
fname [d]
alts d -> p1
show_alt
        buttons :: F (Either (d, Bool) (d, Bool)) (d, Bool)
buttons = F (d, Bool) (d, Bool)
radioAlts forall c d e. F c d -> (e -> c) -> F e d
>=^< forall {a}. Either a a -> a
stripEither
    in  forall a b c. F (Either a b) (Either a c) -> F b c
loopLeftF (forall {b}. Eq b => b -> F (b, Bool) (Either (b, Bool) b)
excludeF d
startalt forall {a1} {b} {a2}. F a1 b -> F a2 a1 -> F a2 b
>==< F (Either (d, Bool) (d, Bool)) (d, Bool)
buttons) forall c d e. F c d -> (e -> c) -> F e d
>=^< (forall {a} {b}. a -> b -> (a, b)
`pair` Bool
True)

radioButtonsF :: Placer -> Bool -> p -> [a] -> (a -> p1) -> F (a, Bool) (a, Bool)
radioButtonsF Placer
placer Bool
inside p
fname [a]
alts a -> p1
show_alt =
  forall {a} {b} {c}.
Eq a =>
Placer -> [(a, F b c)] -> F (a, b) (a, c)
listLF Placer
placer (forall a b. (a -> b) -> [a] -> [b]
map a -> (a, F Bool Bool)
radiobutton [a]
alts)
  where
     radiobutton :: a -> (a, F Bool Bool)
radiobutton a
alt =
        (a
alt, forall {a} {b}. Bool -> Bool -> F a b -> F a b
noStretchF Bool
False Bool
True forall a b. (a -> b) -> a -> b
$ 
              forall {p1} {p2}.
(Graphic p1, Show p2, FontGen p2) =>
Bool -> p2 -> [(ModState, [Char])] -> p1 -> F Bool Bool
oldToggleButtonF' Bool
inside p
fname [] (a -> p1
show_alt a
alt))

excludeF :: b -> F (b, Bool) (Either (b, Bool) b)
excludeF b
start =
    forall a b. SP a b -> F a b
absF (forall b a. [b] -> SP a b -> SP a b
putsSP [forall a b. a -> Either a b
Left (b
start, Bool
True)] (forall {b}. Eq b => b -> SP (b, Bool) (Either (b, Bool) b)
excl b
start))
  where
    excl :: b -> SP (b, Bool) (Either (b, Bool) b)
excl b
last' =
      forall a b. Cont (SP a b) a
getSP forall a b. (a -> b) -> a -> b
$ \(b, Bool)
msg ->
      case (b, Bool)
msg of
	(b
new, Bool
False) -> if b
new forall a. Eq a => a -> a -> Bool
== b
last'
			then forall b a. [b] -> SP a b -> SP a b
putsSP [forall a b. a -> Either a b
Left (b
new, Bool
True)] (b -> SP (b, Bool) (Either (b, Bool) b)
cont b
new)
			else SP (b, Bool) (Either (b, Bool) b)
same
	(b
new, Bool
True)  -> if b
new forall a. Eq a => a -> a -> Bool
== b
last'
		        then forall b a. [b] -> SP a b -> SP a b
putsSP [forall a b. b -> Either a b
Right b
new] (b -> SP (b, Bool) (Either (b, Bool) b)
cont b
new)
		        else forall b a. [b] -> SP a b -> SP a b
putsSP [forall a b. a -> Either a b
Left (b
last', Bool
False), forall a b. b -> Either a b
Right b
new] (b -> SP (b, Bool) (Either (b, Bool) b)
cont b
new)
      where
        same :: SP (b, Bool) (Either (b, Bool) b)
same = b -> SP (b, Bool) (Either (b, Bool) b)
excl b
last'
	cont :: b -> SP (b, Bool) (Either (b, Bool) b)
cont b
last'' = b -> SP (b, Bool) (Either (b, Bool) b)
excl b
last''