module ToggleButtonF(toggleF, oldToggleButtonF, oldToggleButtonF') where
--import Alignment
import Spacer(marginF)
import CompOps((>=^<), (>^=<),(>+<),(>=^^<))
import CompSP(idRightSP)
import SpEither(filterRightSP)
import Spacers(compS,vCenterS,noStretchS)--,centerS,hvAlignS,spacerP
--import Placers(horizontalP)
import Placer(hBoxF,spacer1F)
import EitherUtils(stripEither)
import OnOffDispF
import ButtonBorderF
import ToggleGroupF
--import Geometry(Point(..))
import GraphicsF(graphicsLabelF')
import Defaults(look3d, edgeWidth)
import FDefaults -- setFont

toggleF :: Bool
-> [(ModState, KeySym)]
-> F c b
-> F (Either Bool c) (Either Bool b)
toggleF Bool
inside [(ModState, KeySym)]
keys F c b
lblF =
   [(ModState, KeySym)]
-> F (Either (Either Bool Bool) c) b
-> F (Either Bool c) (Either Bool b)
forall a b.
[(ModState, KeySym)]
-> F (Either (Either Bool Bool) a) b
-> F (Either Bool a) (Either Bool b)
toggleGroupF [(ModState, KeySym)]
keys (F (Either (Either Bool Bool) c) b
 -> F (Either Bool c) (Either Bool b))
-> F (Either (Either Bool Bool) c) b
-> F (Either Bool c) (Either Bool b)
forall a b. (a -> b) -> a -> b
$
   if Bool
inside
   then Int -> F c b -> F (Either Bool c) b
forall a b. Int -> F a b -> F (Either Bool a) b
buttonBorderF Int
edgew (F c b -> F c b
forall a b. F a b -> F a b
mF F c b
lblF) F (Either Bool c) b
-> SP (Either (Either Bool Bool) c) (Either Bool c)
-> F (Either (Either Bool Bool) c) b
forall c d e. F c d -> SP e c -> F e d
>=^^< SP (Either Bool Bool) Bool
-> SP (Either (Either Bool Bool) c) (Either Bool c)
forall a1 a2 b. SP a1 a2 -> SP (Either a1 b) (Either a2 b)
idRightSP SP (Either Bool Bool) Bool
forall a1 b. SP (Either a1 b) b
filterRightSP
   else Either b b -> b
forall p. Either p p -> p
stripEither (Either b b -> b)
-> F (Either (Either Bool Bool) c) (Either b b)
-> F (Either (Either Bool Bool) c) b
forall a b e. (a -> b) -> F e a -> F e b
>^=< F (Either (Either Bool Bool) c) (Either b b)
-> F (Either (Either Bool Bool) c) (Either b b)
forall a b. F a b -> F a b
hBoxF (F (Either Bool Bool) b -> F (Either Bool Bool) b
forall a b. F a b -> F a b
sF (Int -> F Bool b -> F (Either Bool Bool) b
forall a b. Int -> F a b -> F (Either Bool a) b
buttonBorderF Int
edgew F Bool b
forall b. F Bool b
indicatorF) F (Either Bool Bool) b
-> F c b -> F (Either (Either Bool Bool) c) (Either b b)
forall a b c d. F a b -> F c d -> F (Either a c) (Either b d)
>+< F c b -> F c b
forall a b. F a b -> F a b
cF F c b
lblF)
 where
    indicatorF :: F Bool b
indicatorF = F Bool b -> F Bool b
forall a b. F a b -> F a b
mF (Bool -> F Bool b
forall nothing. Bool -> F Bool nothing
onOffDispF Bool
False)
    mF :: F a b -> F a b
mF = Int -> F a b -> F a b
forall a b. Int -> F a b -> F a b
marginF Int
innersep
    sF :: F a b -> F a b
sF = Spacer -> F a b -> F a b
forall a b. Spacer -> F a b -> F a b
spacer1F (Bool -> Bool -> Spacer
noStretchS Bool
True Bool
True Spacer -> Spacer -> Spacer
`compS` Spacer
vCenterS)
    cF :: F a b -> F a b
cF = Spacer -> F a b -> F a b
forall a b. Spacer -> F a b -> F a b
spacer1F (Bool -> Bool -> Spacer
noStretchS Bool
False Bool
True Spacer -> Spacer -> Spacer
`compS` Spacer
vCenterS)
    innersep :: Int
innersep = Int
2
    edgew :: Int
edgew    = if Bool
look3d then Int
edgeWidth else Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
edgeWidthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

oldToggleButtonF :: a -> [(ModState, KeySym)] -> a -> F Bool Bool
oldToggleButtonF a
x = Bool -> a -> [(ModState, KeySym)] -> a -> F Bool Bool
forall a a.
(Graphic a, Show a, FontGen a) =>
Bool -> a -> [(ModState, KeySym)] -> a -> F Bool Bool
oldToggleButtonF' Bool
False a
x

oldToggleButtonF' :: Bool -> a -> [(ModState, KeySym)] -> a -> F Bool Bool
oldToggleButtonF' Bool
inside a
fname [(ModState, KeySym)]
keys a
lbl =
    Either Bool Bool -> Bool
forall p. Either p p -> p
stripEither (Either Bool Bool -> Bool)
-> F (Either Bool Any) (Either Bool Bool)
-> F (Either Bool Any) Bool
forall a b e. (a -> b) -> F e a -> F e b
>^=< Bool
-> [(ModState, KeySym)]
-> F Any Bool
-> F (Either Bool Any) (Either Bool Bool)
forall c b.
Bool
-> [(ModState, KeySym)]
-> F c b
-> F (Either Bool c) (Either Bool b)
toggleF Bool
inside [(ModState, KeySym)]
keys F Any Bool
forall e d. F e d
lblF F (Either Bool Any) Bool
-> (Bool -> Either Bool Any) -> F Bool Bool
forall c d e. F c d -> (e -> c) -> F e d
>=^< Bool -> Either Bool Any
forall a b. a -> Either a b
Left
  where
    lblF :: F e d
lblF = (GraphicsF a -> GraphicsF a) -> a -> F e d
forall a e d.
Graphic a =>
(GraphicsF a -> GraphicsF a) -> a -> F e d
graphicsLabelF' (a -> GraphicsF a -> GraphicsF a
forall xxx a.
(HasFontSpec xxx, Show a, FontGen a) =>
a -> Customiser xxx
setFont a
fname) a
lbl