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 -> a2 -> [(a, a1)] -> a -> F a a
radioF Placer
placer Bool
inside a2
fname [(a, a1)]
alts a
startalt =
  Placer -> Bool -> a2 -> [a] -> a -> (a -> a1) -> F a a
forall d a1 a2.
(Eq d, Graphic a1, Show a2, FontGen a2) =>
Placer -> Bool -> a2 -> [d] -> d -> (d -> a1) -> F d d
oldRadioGroupF Placer
placer Bool
inside a2
fname (((a, a1) -> a) -> [(a, a1)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, a1) -> a
forall a b. (a, b) -> a
fst [(a, a1)]
alts) a
startalt ([(a, a1)] -> a1 -> a -> a1
forall a b. Eq a => [(a, b)] -> b -> a -> b
lookupWithDefault [(a, a1)]
alts ([Char] -> a1
forall a. HasCallStack => [Char] -> a
error [Char]
"radioF"))

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

radioButtonsF :: Placer -> Bool -> a2 -> [a] -> (a -> a1) -> F (a, Bool) (a, Bool)
radioButtonsF Placer
placer Bool
inside a2
fname [a]
alts a -> a1
show_alt =
  Placer -> [(a, F Bool Bool)] -> F (a, Bool) (a, Bool)
forall a b c. Eq a => Placer -> [(a, F b c)] -> F (a, b) (a, c)
listLF Placer
placer ((a -> (a, F Bool Bool)) -> [a] -> [(a, F Bool Bool)]
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, Bool -> Bool -> F Bool Bool -> F Bool Bool
forall a b. Bool -> Bool -> F a b -> F a b
noStretchF Bool
False Bool
True (F Bool Bool -> F Bool Bool) -> F Bool Bool -> F Bool Bool
forall a b. (a -> b) -> a -> b
$ 
              Bool -> a2 -> [(ModState, [Char])] -> a1 -> F Bool Bool
forall a1 a2.
(Graphic a1, Show a2, FontGen a2) =>
Bool -> a2 -> [(ModState, [Char])] -> a1 -> F Bool Bool
oldToggleButtonF' Bool
inside a2
fname [] (a -> a1
show_alt a
alt))

excludeF :: b -> F (b, Bool) (Either (b, Bool) b)
excludeF b
start =
    SP (b, Bool) (Either (b, Bool) b)
-> F (b, Bool) (Either (b, Bool) b)
forall a b. SP a b -> F a b
absF ([Either (b, Bool) b]
-> SP (b, Bool) (Either (b, Bool) b)
-> SP (b, Bool) (Either (b, Bool) b)
forall b a. [b] -> SP a b -> SP a b
putsSP [(b, Bool) -> Either (b, Bool) b
forall a b. a -> Either a b
Left (b
start, Bool
True)] (b -> SP (b, Bool) (Either (b, Bool) b)
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' =
      Cont (SP (b, Bool) (Either (b, Bool) b)) (b, Bool)
forall a b. Cont (SP a b) a
getSP Cont (SP (b, Bool) (Either (b, Bool) b)) (b, Bool)
-> Cont (SP (b, Bool) (Either (b, Bool) b)) (b, Bool)
forall a b. (a -> b) -> a -> b
$ \(b, Bool)
msg ->
      case (b, Bool)
msg of
	(b
new, Bool
False) -> if b
new b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
last'
			then [Either (b, Bool) b]
-> SP (b, Bool) (Either (b, Bool) b)
-> SP (b, Bool) (Either (b, Bool) b)
forall b a. [b] -> SP a b -> SP a b
putsSP [(b, Bool) -> Either (b, Bool) b
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 b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
last'
		        then [Either (b, Bool) b]
-> SP (b, Bool) (Either (b, Bool) b)
-> SP (b, Bool) (Either (b, Bool) b)
forall b a. [b] -> SP a b -> SP a b
putsSP [b -> Either (b, Bool) b
forall a b. b -> Either a b
Right b
new] (b -> SP (b, Bool) (Either (b, Bool) b)
cont b
new)
		        else [Either (b, Bool) b]
-> SP (b, Bool) (Either (b, Bool) b)
-> SP (b, Bool) (Either (b, Bool) b)
forall b a. [b] -> SP a b -> SP a b
putsSP [(b, Bool) -> Either (b, Bool) b
forall a b. a -> Either a b
Left (b
last', Bool
False), b -> Either (b, Bool) b
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''