module ShapedButtonsF (radioF1, radioGroupF1, toggleF1, toggleButtonF1, RBBT (..)) where
import AllFudgets
import HbcUtils(lookupWithDefault)

data RBBT = Circle | Square | Triangle
type RadioButtonBorderType = RBBT

radioF1 :: RadioButtonBorderType -> FontName -> [(a, FontName)] -> a -> F a a
radioF1 RadioButtonBorderType
bbt FontName
fname [(a, FontName)]
alts a
startalt =
    RadioButtonBorderType
-> FontName -> [a] -> a -> (a -> FontName) -> F a a
forall a.
Eq a =>
RadioButtonBorderType
-> FontName -> [a] -> a -> (a -> FontName) -> F a a
radioGroupF1 RadioButtonBorderType
bbt FontName
fname (((a, FontName) -> a) -> [(a, FontName)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, FontName) -> a
forall a b. (a, b) -> a
fst [(a, FontName)]
alts) a
startalt 
      ([(a, FontName)] -> FontName -> a -> FontName
forall a b. Eq a => [(a, b)] -> b -> a -> b
lookupWithDefault [(a, FontName)]
alts (FontName -> FontName
forall a. HasCallStack => FontName -> a
error FontName
"radioF"))

radioGroupF1 :: Eq a => RadioButtonBorderType -> FontName -> [a] -> a -> 
                        (a -> String) -> F a a
radioGroupF1 :: RadioButtonBorderType
-> FontName -> [a] -> a -> (a -> FontName) -> F a a
radioGroupF1 RadioButtonBorderType
bbt FontName
fname [a]
alts a
startalt a -> FontName
show_alt =
    let radioAlts :: F (a, Bool) (a, Bool)
radioAlts = RadioButtonBorderType
-> FontName -> [a] -> (a -> FontName) -> F (a, Bool) (a, Bool)
forall a.
Eq a =>
RadioButtonBorderType
-> FontName -> [a] -> (a -> FontName) -> F (a, Bool) (a, Bool)
radioButtonsF1 RadioButtonBorderType
bbt FontName
fname [a]
alts a -> FontName
show_alt
        buttons :: F (Either (a, Bool) (a, Bool)) (a, Bool)
buttons = F (a, Bool) (a, Bool)
radioAlts F (a, Bool) (a, Bool)
-> (Either (a, Bool) (a, Bool) -> (a, Bool))
-> F (Either (a, Bool) (a, Bool)) (a, Bool)
forall c d e. F c d -> (e -> c) -> F e d
>=^< Either (a, Bool) (a, Bool) -> (a, Bool)
forall p. Either p p -> p
stripEither
    in  F (Either (a, Bool) (a, Bool)) (Either (a, Bool) a)
-> F (a, Bool) a
forall a b c. F (Either a b) (Either a c) -> F b c
loopLeftF (a -> F (a, Bool) (Either (a, Bool) a)
forall b. Eq b => b -> F (b, Bool) (Either (b, Bool) b)
excludeF1 a
startalt F (a, Bool) (Either (a, Bool) a)
-> F (Either (a, Bool) (a, Bool)) (a, Bool)
-> F (Either (a, Bool) (a, Bool)) (Either (a, Bool) a)
forall a1 b a2. F a1 b -> F a2 a1 -> F a2 b
>==< F (Either (a, Bool) (a, Bool)) (a, Bool)
buttons) F (a, Bool) a -> (a -> (a, Bool)) -> F a a
forall c d e. F c d -> (e -> c) -> F e d
>=^<
        (\a
x -> a -> Bool -> (a, Bool)
forall a b. a -> b -> (a, b)
pair a
x Bool
True)

radioButtonsF1 :: RadioButtonBorderType
-> FontName -> [a] -> (a -> FontName) -> F (a, Bool) (a, Bool)
radioButtonsF1 RadioButtonBorderType
bbt FontName
fname [a]
alts a -> FontName
show_alt =
    let 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 
               (RadioButtonBorderType
-> FontName -> [(ModState, FontName)] -> FontName -> F Bool Bool
toggleButtonF1 RadioButtonBorderType
bbt FontName
fname [] (a -> FontName
show_alt a
alt))
            )
    in  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 (Distance -> Placer
verticalP' Distance
0) ((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)

excludeF1 :: b -> F (b, Bool) (Either (b, Bool) b)
excludeF1 b
start =
    let excl :: b -> SP (b, Bool) (Either (b, Bool) b)
excl b
last' =
            let 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''
            in  Cont (SP (b, Bool) (Either (b, Bool) b)) (b, Bool)
forall a b. Cont (SP a b) a
getSP (\(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))
    in  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))

toggleF1 :: RadioButtonBorderType
-> [(ModState, FontName)]
-> F a b
-> F (Either Bool a) (Either Bool b)
toggleF1 RadioButtonBorderType
bbt [(ModState, FontName)]
keys F a b
f =
  case RadioButtonBorderType
bbt of
    RadioButtonBorderType
Square ->
      let edgew :: Distance
edgew = Distance
3
          dsize :: Point
dsize = Distance -> Distance -> Point
Point Distance
10 Distance
10
          innersep :: Distance
innersep = Distance
3
          fudgetsep :: Distance
fudgetsep = Distance
5
          toggleK :: K Bool ho
toggleK =
              let cid :: Bool -> p
cid Bool
False = p
0
                  cid Bool
True = p
1
              in  ColormapId -> FontName -> Cont (K Bool ho) Pixel
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
ColormapId -> FontName -> Cont (f b ho) Pixel
allocNamedColorPixel ColormapId
defaultColormap
                                  FontName
onColor1
                                  (\Pixel
onC ->
                                   ColormapId -> FontName -> Cont (K Bool ho) Pixel
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
ColormapId -> FontName -> Cont (f b ho) Pixel
allocNamedColorPixel ColormapId
defaultColormap
                                                   FontName
offColor1
                                                   (\Pixel
offC ->
                                                    let toggle :: Bool -> [Message FRequest b]
toggle Bool
s =
                                                            (XCommand -> Message FRequest b)
-> [XCommand] -> [Message FRequest b]
forall a b. (a -> b) -> [a] -> [b]
map (FRequest -> Message FRequest b
forall a b. a -> Message a b
Low (FRequest -> Message FRequest b)
-> (XCommand -> FRequest) -> XCommand -> Message FRequest b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XCommand -> FRequest
XCmd)
                                                                [[WindowAttributes] -> XCommand
ChangeWindowAttributes [Pixel -> WindowAttributes
CWBackPixel (if Bool
s then Pixel
onC else Pixel
offC)],
                                                                 XCommand
ClearWindow]
                                                        k :: Message a Bool -> [Message FRequest b]
k (High Bool
s) = Bool -> [Message FRequest b]
forall b. Bool -> [Message FRequest b]
toggle Bool
s
                                                        k Message a Bool
_ = []
                                                    in  [KCommand ho] -> K Bool ho -> K Bool ho
forall b a. [KCommand b] -> K a b -> K a b
putsK (FRequest -> KCommand ho
forall a b. a -> Message a b
Low (LayoutRequest -> FRequest
layoutRequestCmd (Point -> Bool -> Bool -> LayoutRequest
plainLayout Point
dsize Bool
True Bool
True)) KCommand ho -> [KCommand ho] -> [KCommand ho]
forall a. a -> [a] -> [a]
:
                                                              Bool -> [KCommand ho]
forall b. Bool -> [Message FRequest b]
toggle Bool
False)
                                                             (KSP Bool ho -> K Bool ho
forall hi ho. KSP hi ho -> K hi ho
K (KSP Bool ho -> K Bool ho) -> KSP Bool ho -> K Bool ho
forall a b. (a -> b) -> a -> b
$ (Message FResponse Bool -> [KCommand ho]) -> KSP Bool ho
forall t b. (t -> [b]) -> SP t b
concmapSP Message FResponse Bool -> [KCommand ho]
forall a b. Message a Bool -> [Message FRequest b]
k)))
          toggleb :: F (Either Bool Bool) b
toggleb =
                RadioButtonBorderType
-> Distance -> F Bool b -> F (Either Bool Bool) b
forall a b.
RadioButtonBorderType -> Distance -> F a b -> F (Either Bool a) b
buttonBorderF1 RadioButtonBorderType
bbt Distance
edgew
                              (Distance -> F Bool b -> F Bool b
forall a b. Distance -> F a b -> F a b
marginF Distance
innersep
                                    ([FRequest] -> K Bool b -> F Bool b
forall a b. [FRequest] -> K a b -> F a b
windowF [{-ConfigureWindow [CWBorderWidth 0]-}] K Bool b
forall ho. K Bool ho
toggleK))
          togglebd :: F (Either (Either Bool Bool) a) b
togglebd =
              let post :: Either a (Either (Either a b) (Either a b)) -> Either a b
post (Left a
a) = a -> Either a b
forall a b. a -> Either a b
Left a
a
                  post (Right Either (Either a b) (Either a b)
b) = Either (Either a b) (Either a b) -> Either a b
forall p. Either p p -> p
stripEither Either (Either a b) (Either a b)
b
              in  Either b b -> b
forall p. Either p p -> p
stripEither (Either b b -> b)
-> F (Either (Either Bool Bool) a) (Either b b)
-> F (Either (Either Bool Bool) a) b
forall a b e. (a -> b) -> F e a -> F e b
>^=<
                  (Distance
-> Alignment
-> Alignment
-> F (Either Bool Bool) b
-> F (Either Bool Bool) b
forall a b. Distance -> Alignment -> Alignment -> F a b -> F a b
marginHVAlignF Distance
0 Alignment
aCenter Alignment
aCenter F (Either Bool Bool) b
forall b. F (Either Bool Bool) b
toggleb F (Either Bool Bool) b
-> (Distance, Orientation, F a b)
-> F (Either (Either Bool Bool) a) (Either b b)
forall a b c d.
F a b
-> (Distance, Orientation, F c d) -> F (Either a c) (Either b d)
>+#<
                   (Distance
fudgetsep, Orientation
LeftOf, F a b
f))
      in  [(ModState, FontName)]
-> F (Either (Either Bool Bool) a) b
-> F (Either Bool a) (Either Bool b)
forall a b.
[(ModState, FontName)]
-> F (Either (Either Bool Bool) a) b
-> F (Either Bool a) (Either Bool b)
toggleGroupF [(ModState, FontName)]
keys (Distance
-> Alignment
-> Alignment
-> F (Either (Either Bool Bool) a) b
-> F (Either (Either Bool Bool) a) b
forall a b. Distance -> Alignment -> Alignment -> F a b -> F a b
marginHVAlignF Distance
0 Alignment
aLeft Alignment
aCenter F (Either (Either Bool Bool) a) b
togglebd)
    RadioButtonBorderType
Triangle ->
      let edgew :: Distance
edgew = Distance
3
          dsize :: Point
dsize = Distance -> Distance -> Point
Point Distance
12 Distance
12
          innersep :: Distance
innersep = Distance
6
          fudgetsep :: Distance
fudgetsep = Distance
5
          toggleK :: K Bool ho
toggleK =
              let cid :: Bool -> p
cid Bool
False = p
0
                  cid Bool
True = p
1
              in  ColormapId -> FontName -> Cont (K Bool ho) Pixel
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
ColormapId -> FontName -> Cont (f b ho) Pixel
allocNamedColorPixel ColormapId
defaultColormap
                                  FontName
onColor1
                                  (\Pixel
onC ->
                                   ColormapId -> FontName -> Cont (K Bool ho) Pixel
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
ColormapId -> FontName -> Cont (f b ho) Pixel
allocNamedColorPixel ColormapId
defaultColormap
                                                   FontName
offColor1
                                                   (\Pixel
offC ->
                                                    let toggle :: Bool -> [Message FRequest b]
toggle Bool
s =
                                                            (XCommand -> Message FRequest b)
-> [XCommand] -> [Message FRequest b]
forall a b. (a -> b) -> [a] -> [b]
map (FRequest -> Message FRequest b
forall a b. a -> Message a b
Low (FRequest -> Message FRequest b)
-> (XCommand -> FRequest) -> XCommand -> Message FRequest b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XCommand -> FRequest
XCmd)
                                                                [[WindowAttributes] -> XCommand
ChangeWindowAttributes [Pixel -> WindowAttributes
CWBackPixel (if Bool
s then Pixel
onC else Pixel
offC)],
                                                                 XCommand
ClearWindow]
                                                        k :: Message a Bool -> [Message FRequest b]
k (High Bool
s) = Bool -> [Message FRequest b]
forall b. Bool -> [Message FRequest b]
toggle Bool
s
                                                        k Message a Bool
_ = []
                                                    in  [KCommand ho] -> K Bool ho -> K Bool ho
forall b a. [KCommand b] -> K a b -> K a b
putsK (FRequest -> KCommand ho
forall a b. a -> Message a b
Low (LayoutRequest -> FRequest
layoutRequestCmd (Point -> Bool -> Bool -> LayoutRequest
plainLayout Point
dsize Bool
True Bool
True)) KCommand ho -> [KCommand ho] -> [KCommand ho]
forall a. a -> [a] -> [a]
:
                                                              Bool -> [KCommand ho]
forall b. Bool -> [Message FRequest b]
toggle Bool
False)
                                                             (KSP Bool ho -> K Bool ho
forall hi ho. KSP hi ho -> K hi ho
K (KSP Bool ho -> K Bool ho) -> KSP Bool ho -> K Bool ho
forall a b. (a -> b) -> a -> b
$ (Message FResponse Bool -> [KCommand ho]) -> KSP Bool ho
forall t b. (t -> [b]) -> SP t b
concmapSP Message FResponse Bool -> [KCommand ho]
forall a b. Message a Bool -> [Message FRequest b]
k)))
          vormT :: Point -> [DrawCommand]
vormT Point
punt = [Shape -> CoordMode -> [Point] -> DrawCommand
FillPolygon Shape
Nonconvex CoordMode
CoordModeOrigin [Point
origin, Point -> Point -> Point
padd Point
origin (Distance -> Distance -> Point
Point Distance
0 ((Point -> Distance
ycoord Point
punt)Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
-Distance
1)),
                        Point -> Point -> Point
padd Point
origin (Distance -> Distance -> Point
Point ((Point -> Distance
xcoord Point
punt)Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
-Distance
1) (((Point -> Distance
ycoord Point
punt)Distance -> Distance -> Distance
forall a. Integral a => a -> a -> a
`div`Distance
2)Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
-Distance
1))]]
          toggleb :: F (Either Bool Bool) b
toggleb =
                RadioButtonBorderType
-> Distance -> F Bool b -> F (Either Bool Bool) b
forall a b.
RadioButtonBorderType -> Distance -> F a b -> F (Either Bool a) b
buttonBorderF1 RadioButtonBorderType
bbt Distance
edgew
                              (Distance -> F Bool b -> F Bool b
forall a b. Distance -> F a b -> F a b
marginF Distance
innersep
                                    ([FRequest] -> K Bool b -> F Bool b
forall a b. [FRequest] -> K a b -> F a b
windowF [{-ConfigureWindow [CWBorderWidth 0]-}]
                                              ((Point -> [DrawCommand]) -> K Bool b -> K Bool b
forall a b. (Point -> [DrawCommand]) -> K a b -> K a b
shapeK Point -> [DrawCommand]
vormT K Bool b
forall ho. K Bool ho
toggleK)))
          togglebd :: F (Either (Either Bool Bool) a) b
togglebd =
              let post :: Either a (Either (Either a b) (Either a b)) -> Either a b
post (Left a
a) = a -> Either a b
forall a b. a -> Either a b
Left a
a
                  post (Right Either (Either a b) (Either a b)
b) = Either (Either a b) (Either a b) -> Either a b
forall p. Either p p -> p
stripEither Either (Either a b) (Either a b)
b
              in  Either b b -> b
forall p. Either p p -> p
stripEither (Either b b -> b)
-> F (Either (Either Bool Bool) a) (Either b b)
-> F (Either (Either Bool Bool) a) b
forall a b e. (a -> b) -> F e a -> F e b
>^=<
                  (Distance
-> Alignment
-> Alignment
-> F (Either Bool Bool) b
-> F (Either Bool Bool) b
forall a b. Distance -> Alignment -> Alignment -> F a b -> F a b
marginHVAlignF Distance
0 Alignment
aCenter Alignment
aCenter F (Either Bool Bool) b
forall b. F (Either Bool Bool) b
toggleb F (Either Bool Bool) b
-> (Distance, Orientation, F a b)
-> F (Either (Either Bool Bool) a) (Either b b)
forall a b c d.
F a b
-> (Distance, Orientation, F c d) -> F (Either a c) (Either b d)
>+#<
                   (Distance
fudgetsep, Orientation
LeftOf, F a b
f))
      in  [(ModState, FontName)]
-> F (Either (Either Bool Bool) a) b
-> F (Either Bool a) (Either Bool b)
forall a b.
[(ModState, FontName)]
-> F (Either (Either Bool Bool) a) b
-> F (Either Bool a) (Either Bool b)
toggleGroupF [(ModState, FontName)]
keys (Distance
-> Alignment
-> Alignment
-> F (Either (Either Bool Bool) a) b
-> F (Either (Either Bool Bool) a) b
forall a b. Distance -> Alignment -> Alignment -> F a b -> F a b
marginHVAlignF Distance
0 Alignment
aLeft Alignment
aCenter F (Either (Either Bool Bool) a) b
togglebd)
    RadioButtonBorderType
Circle ->
      let edgew :: Distance
edgew = Distance
3
          dsize :: Point
dsize = Distance -> Distance -> Point
Point Distance
16 Distance
16
          innersep :: Distance
innersep = Distance
2
          fudgetsep :: Distance
fudgetsep = Distance
5
          toggleK :: K Bool ho
toggleK =
              let cid :: Bool -> p
cid Bool
False = p
0
                  cid Bool
True = p
1
              in  ColormapId -> FontName -> Cont (K Bool ho) Pixel
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
ColormapId -> FontName -> Cont (f b ho) Pixel
allocNamedColorPixel ColormapId
defaultColormap
                                  FontName
onColor1
                                  (\Pixel
onC ->
                                   ColormapId -> FontName -> Cont (K Bool ho) Pixel
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
ColormapId -> FontName -> Cont (f b ho) Pixel
allocNamedColorPixel ColormapId
defaultColormap
                                                   FontName
offColor1
                                                   (\Pixel
offC ->
                                                    let toggle :: Bool -> [Message FRequest b]
toggle Bool
s =
                                                            (XCommand -> Message FRequest b)
-> [XCommand] -> [Message FRequest b]
forall a b. (a -> b) -> [a] -> [b]
map (FRequest -> Message FRequest b
forall a b. a -> Message a b
Low (FRequest -> Message FRequest b)
-> (XCommand -> FRequest) -> XCommand -> Message FRequest b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XCommand -> FRequest
XCmd)
                                                                [[WindowAttributes] -> XCommand
ChangeWindowAttributes [Pixel -> WindowAttributes
CWBackPixel (if Bool
s then Pixel
onC else Pixel
offC)],
                                                                 XCommand
ClearWindow]
                                                        k :: Message a Bool -> [Message FRequest b]
k (High Bool
s) = Bool -> [Message FRequest b]
forall b. Bool -> [Message FRequest b]
toggle Bool
s
                                                        k Message a Bool
_ = []
                                                    in  [KCommand ho] -> K Bool ho -> K Bool ho
forall b a. [KCommand b] -> K a b -> K a b
putsK (FRequest -> KCommand ho
forall a b. a -> Message a b
Low (LayoutRequest -> FRequest
layoutRequestCmd (Point -> Bool -> Bool -> LayoutRequest
plainLayout Point
dsize Bool
True Bool
True)) KCommand ho -> [KCommand ho] -> [KCommand ho]
forall a. a -> [a] -> [a]
:
                                                              Bool -> [KCommand ho]
forall b. Bool -> [Message FRequest b]
toggle Bool
False)
                                                             (KSP Bool ho -> K Bool ho
forall hi ho. KSP hi ho -> K hi ho
K (KSP Bool ho -> K Bool ho) -> KSP Bool ho -> K Bool ho
forall a b. (a -> b) -> a -> b
$ (Message FResponse Bool -> [KCommand ho]) -> KSP Bool ho
forall t b. (t -> [b]) -> SP t b
concmapSP Message FResponse Bool -> [KCommand ho]
forall a b. Message a Bool -> [Message FRequest b]
k)))
          vormC :: Point -> [DrawCommand]
vormC Point
punt = [Rect -> Distance -> Distance -> DrawCommand
FillArc (Point -> Point -> Rect
Rect Point
origin (Distance -> Distance -> Point
Point ((Point -> Distance
xcoord Point
punt)Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
-Distance
1) ((Point -> Distance
ycoord Point
punt)Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
-Distance
1))) (Distance
0Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
*Distance
64) (Distance
360Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
*Distance
64)]
          toggleb :: F (Either Bool Bool) b
toggleb =
                RadioButtonBorderType
-> Distance -> F Bool b -> F (Either Bool Bool) b
forall a b.
RadioButtonBorderType -> Distance -> F a b -> F (Either Bool a) b
buttonBorderF1 RadioButtonBorderType
bbt Distance
edgew
                              (Distance -> F Bool b -> F Bool b
forall a b. Distance -> F a b -> F a b
marginF Distance
innersep
                                    ([FRequest] -> K Bool b -> F Bool b
forall a b. [FRequest] -> K a b -> F a b
windowF [{-ConfigureWindow [CWBorderWidth 0]-}]
                                             ((Point -> [DrawCommand]) -> K Bool b -> K Bool b
forall a b. (Point -> [DrawCommand]) -> K a b -> K a b
shapeK Point -> [DrawCommand]
vormC K Bool b
forall ho. K Bool ho
toggleK)))
          togglebd :: F (Either (Either Bool Bool) a) b
togglebd =
              let post :: Either a (Either (Either a b) (Either a b)) -> Either a b
post (Left a
a) = a -> Either a b
forall a b. a -> Either a b
Left a
a
                  post (Right Either (Either a b) (Either a b)
b) = Either (Either a b) (Either a b) -> Either a b
forall p. Either p p -> p
stripEither Either (Either a b) (Either a b)
b
              in  Either b b -> b
forall p. Either p p -> p
stripEither (Either b b -> b)
-> F (Either (Either Bool Bool) a) (Either b b)
-> F (Either (Either Bool Bool) a) b
forall a b e. (a -> b) -> F e a -> F e b
>^=<
                  (Distance
-> Alignment
-> Alignment
-> F (Either Bool Bool) b
-> F (Either Bool Bool) b
forall a b. Distance -> Alignment -> Alignment -> F a b -> F a b
marginHVAlignF Distance
0 Alignment
aCenter Alignment
aCenter F (Either Bool Bool) b
forall b. F (Either Bool Bool) b
toggleb F (Either Bool Bool) b
-> (Distance, Orientation, F a b)
-> F (Either (Either Bool Bool) a) (Either b b)
forall a b c d.
F a b
-> (Distance, Orientation, F c d) -> F (Either a c) (Either b d)
>+#<
                   (Distance
fudgetsep, Orientation
LeftOf, F a b
f))
      in  [(ModState, FontName)]
-> F (Either (Either Bool Bool) a) b
-> F (Either Bool a) (Either Bool b)
forall a b.
[(ModState, FontName)]
-> F (Either (Either Bool Bool) a) b
-> F (Either Bool a) (Either Bool b)
toggleGroupF [(ModState, FontName)]
keys (Distance
-> Alignment
-> Alignment
-> F (Either (Either Bool Bool) a) b
-> F (Either (Either Bool Bool) a) b
forall a b. Distance -> Alignment -> Alignment -> F a b -> F a b
marginHVAlignF Distance
0 Alignment
aLeft Alignment
aCenter F (Either (Either Bool Bool) a) b
togglebd)

toggleButtonF1 :: RadioButtonBorderType -> String -> [(ModState, KeySym)] -> String -> F Bool Bool
toggleButtonF1 :: RadioButtonBorderType
-> FontName -> [(ModState, FontName)] -> FontName -> F Bool Bool
toggleButtonF1 RadioButtonBorderType
bbt FontName
fname [(ModState, FontName)]
keys FontName
text =
  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
>^=<
  RadioButtonBorderType
-> [(ModState, FontName)]
-> F Any Bool
-> F (Either Bool Any) (Either Bool Bool)
forall a b.
RadioButtonBorderType
-> [(ModState, FontName)]
-> F a b
-> F (Either Bool a) (Either Bool b)
toggleF1 RadioButtonBorderType
bbt [(ModState, FontName)]
keys (Bool -> Bool -> F Any Bool -> F Any Bool
forall a b. Bool -> Bool -> F a b -> F a b
noStretchF Bool
True Bool
True (Customiser (DisplayF FontName) -> FontName -> F Any Bool
forall g a b. Graphic g => Customiser (DisplayF g) -> g -> F a b
labelF' (FontName -> Customiser (DisplayF FontName)
forall xxx a.
(HasFontSpec xxx, Show a, FontGen a) =>
a -> Customiser xxx
setFont FontName
fname) FontName
text))
  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

offColor1 :: FontName
offColor1 = FontName -> FontName -> FontName
argKey FontName
"toggleoff" FontName
bgColor

onColor1 :: FontName
onColor1 = FontName -> FontName -> FontName
argKey FontName
"toggleon" FontName
fgColor

buttonBorderF1 :: RadioButtonBorderType -> Int -> (F a b) -> F (Either Bool a) b
buttonBorderF1 :: RadioButtonBorderType -> Distance -> F a b -> F (Either Bool a) b
buttonBorderF1 = RadioButtonBorderType -> Distance -> F a b -> F (Either Bool a) b
forall a b.
RadioButtonBorderType -> Distance -> F a b -> F (Either Bool a) b
stdButtonBorderF1

stdButtonBorderF1 :: RadioButtonBorderType -> Distance -> F c b -> F (Either Bool c) b
stdButtonBorderF1 RadioButtonBorderType
bbt Distance
edgew F c b
f =
    let kernel :: K Bool ho
kernel =
          ColormapId
-> FontName -> FontName -> (Pixel -> K Bool ho) -> K Bool ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
ColormapId -> FontName -> FontName -> (Pixel -> f b ho) -> f b ho
allocNamedColorDefPixel ColormapId
defaultColormap FontName
shineColor FontName
"white" ((Pixel -> K Bool ho) -> K Bool ho)
-> (Pixel -> K Bool ho) -> K Bool ho
forall a b. (a -> b) -> a -> b
$ \Pixel
shine ->
          ColormapId
-> FontName -> FontName -> (Pixel -> K Bool ho) -> K Bool ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
ColormapId -> FontName -> FontName -> (Pixel -> f b ho) -> f b ho
allocNamedColorDefPixel ColormapId
defaultColormap FontName
shadowColor FontName
"black" ((Pixel -> K Bool ho) -> K Bool ho)
-> (Pixel -> K Bool ho) -> K Bool ho
forall a b. (a -> b) -> a -> b
$ \Pixel
shadow ->
          GCId
-> [GCAttributes Pixel FontId] -> (GCId -> K Bool ho) -> K Bool ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
GCId -> [GCAttributes Pixel FontId] -> (GCId -> f b ho) -> f b ho
wCreateGC GCId
rootGC [GCFunction -> GCAttributes Pixel FontId
forall a b. GCFunction -> GCAttributes a b
GCFunction GCFunction
GXcopy, Pixel -> GCAttributes Pixel FontId
forall a b. a -> GCAttributes a b
GCForeground Pixel
shadow,
                            Pixel -> GCAttributes Pixel FontId
forall a b. a -> GCAttributes a b
GCBackground Pixel
shine] ((GCId -> K Bool ho) -> K Bool ho)
-> (GCId -> K Bool ho) -> K Bool ho
forall a b. (a -> b) -> a -> b
$ \GCId
drawGC ->
          GCId
-> [GCAttributes Pixel FontId] -> (GCId -> K Bool ho) -> K Bool ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
GCId -> [GCAttributes Pixel FontId] -> (GCId -> f b ho) -> f b ho
wCreateGC GCId
rootGC [GCFunction -> GCAttributes Pixel FontId
forall a b. GCFunction -> GCAttributes a b
GCFunction GCFunction
GXcopy, Pixel -> GCAttributes Pixel FontId
forall a b. a -> GCAttributes a b
GCForeground Pixel
shine, Pixel -> GCAttributes Pixel FontId
forall a b. a -> GCAttributes a b
GCBackground Pixel
shine] ((GCId -> K Bool ho) -> K Bool ho)
-> (GCId -> K Bool ho) -> K Bool ho
forall a b. (a -> b) -> a -> b
$ \GCId
extraGC ->
          GCId
-> [GCAttributes Pixel FontId] -> (GCId -> K Bool ho) -> K Bool ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
GCId -> [GCAttributes Pixel FontId] -> (GCId -> f b ho) -> f b ho
wCreateGC GCId
rootGC (Pixel -> Pixel -> [GCAttributes Pixel FontId]
forall b. Pixel -> Pixel -> [GCAttributes Pixel b]
invertColorGCattrs Pixel
shine Pixel
shadow) ((GCId -> K Bool ho) -> K Bool ho)
-> (GCId -> K Bool ho) -> K Bool ho
forall a b. (a -> b) -> a -> b
$ \GCId
invertGC ->
          let
              dRAWS :: Point -> ([Message FRequest b], [Message FRequest b])
dRAWS Point
s =
                    let bpx :: Distance
bpx = Distance
edgew
                        bpy :: Distance
bpy = Distance
edgew
                        upperLeftCorner :: Point
upperLeftCorner = Distance -> Distance -> Point
Point Distance
bpx Distance
bpy
                        size :: Point
size@(Point Distance
sx Distance
sy) = Point -> Point -> Point
psub Point
s (Distance -> Distance -> Point
Point Distance
1 Distance
1)
                        rect :: Rect
rect = Point -> Point -> Rect
Rect Point
origin Point
size
                        upperRightCorner :: Point
upperRightCorner = Distance -> Distance -> Point
Point (Distance
sx Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
- Distance
bpx) Distance
bpy
                        lowerLeftCorner :: Point
lowerLeftCorner = Distance -> Distance -> Point
Point Distance
bpx (Distance
sy Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
- Distance
bpy)
                        lowerRightCorner :: Point
lowerRightCorner = Point -> Point -> Point
psub Point
size Point
upperLeftCorner
                        leftBorder :: Line
leftBorder = Point -> Point -> Line
Line Point
upperLeftCorner Point
lowerLeftCorner
                        upperBorder :: Line
upperBorder = Point -> Point -> Line
Line Point
upperLeftCorner Point
upperRightCorner
                        upperLeftLine :: Line
upperLeftLine = Point -> Point -> Line
Line Point
origin Point
upperLeftCorner
                        lowerRightLine :: Line
lowerRightLine = Point -> Point -> Line
Line Point
lowerRightCorner Point
size
                        incx :: Point -> Point
incx = Point -> Point -> Point
padd (Distance -> Distance -> Point
Point Distance
1 Distance
0)
                        incy :: Point -> Point
incy = Point -> Point -> Point
padd (Distance -> Distance -> Point
Point Distance
0 Distance
1)
                        decx :: Point -> Point
decx = Point -> Point -> Point
padd (Distance -> Distance -> Point
Point (-Distance
1) Distance
0)
                        decy :: Point -> Point
decy = Point -> Point -> Point
padd (Distance -> Distance -> Point
Point Distance
0 (-Distance
1))
                        lowerBorderPoints :: [Point]
lowerBorderPoints = [Point
lowerLeftCorner, Point
lowerRightCorner,
                                             Point
upperRightCorner, Distance -> Distance -> Point
Point Distance
sx Distance
0, Point
size, Distance -> Distance -> Point
Point Distance
0 Distance
sy]
                        borderPoints :: [Point]
borderPoints =
                          [Distance -> Distance -> Point
pP Distance
1 Distance
1, Distance -> Distance -> Point
pP Distance
1 Distance
sy, Point
size, Distance -> Distance -> Point
pP Distance
sx Distance
1, Point
origin, Point
upperLeftCorner,
                           Point -> Point
incy Point
lowerLeftCorner, (Point -> Point
incx (Point -> Point) -> (Point -> Point) -> Point -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Point
incy) Point
lowerRightCorner,
                           Point -> Point
incx Point
upperRightCorner, Point
upperLeftCorner]
                        rectPoints :: [Point]
rectPoints = [Point
origin, Point -> Point -> Point
padd Point
origin (Distance -> Distance -> Point
Point (Distance
sxDistance -> Distance -> Distance
forall a. Num a => a -> a -> a
-Distance
1) Distance
0), Point
size, Point -> Point -> Point
padd Point
origin (Distance -> Distance -> Point
Point Distance
0 (Distance
syDistance -> Distance -> Distance
forall a. Num a => a -> a -> a
-Distance
1))]
                    in  ((FRequest -> Message FRequest b)
-> [FRequest] -> [Message FRequest b]
forall a b. (a -> b) -> [a] -> [b]
map FRequest -> Message FRequest b
forall a b. a -> Message a b
Low [
                                  GCId -> Shape -> CoordMode -> [Point] -> FRequest
wFillPolygon GCId
extraGC Shape
Convex CoordMode
CoordModeOrigin [Point]
rectPoints,
                                  GCId -> Shape -> CoordMode -> [Point] -> FRequest
wFillPolygon GCId
drawGC Shape
Nonconvex CoordMode
CoordModeOrigin [Point]
lowerBorderPoints,
                                  GCId -> Line -> FRequest
wDrawLine GCId
drawGC Line
leftBorder,
                                  GCId -> Line -> FRequest
wDrawLine GCId
drawGC Line
upperBorder,
                                  GCId -> Line -> FRequest
wDrawLine GCId
drawGC Line
upperLeftLine,
                                  GCId -> Line -> FRequest
wDrawLine GCId
invertGC Line
lowerRightLine,
                                  GCId -> Rect -> FRequest
wDrawRectangle GCId
drawGC Rect
rect
                                 ],
                                 [FRequest -> Message FRequest b
forall a b. a -> Message a b
Low (GCId -> Shape -> CoordMode -> [Point] -> FRequest
wFillPolygon GCId
invertGC Shape
Nonconvex CoordMode
CoordModeOrigin [Point]
borderPoints)])
              dRAWT :: Point -> ([Message FRequest b], [Message FRequest b])
dRAWT Point
s =
                    let bpx :: Distance
bpx = Distance
edgew
                        bpy :: Distance
bpy = Distance
edgewDistance -> Distance -> Distance
forall a. Num a => a -> a -> a
+Distance
2
                        upperLeftCorner :: Point
upperLeftCorner = Distance -> Distance -> Point
Point Distance
bpx Distance
bpy
                        size :: Point
size@(Point Distance
sx Distance
sy) = Point -> Point -> Point
psub Point
s (Distance -> Distance -> Point
Point Distance
1 Distance
1)
                        ap :: Point
ap = Point -> Point -> Point
padd Point
origin (Distance -> Distance -> Point
Point Distance
5 Distance
2)
                        bp :: Point
bp = Point -> Point -> Point
padd Point
origin (Distance -> Distance -> Point
Point Distance
5 (Distance
syDistance -> Distance -> Distance
forall a. Num a => a -> a -> a
-Distance
3))
                        cp :: Point
cp = Distance -> Distance -> Point
Point (Distance
sx) (((Distance
sy Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
- Distance
bpy)Distance -> Distance -> Distance
forall a. Integral a => a -> a -> a
`div`Distance
2)Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
+Distance
2)
                        dp :: Point
dp = Point -> Point -> Point
padd Point
ap (Distance -> Distance -> Point
Point Distance
bpx Distance
bpy)
                        ep :: Point
ep = Point -> Point -> Point
padd Point
bp (Distance -> Distance -> Point
Point Distance
bpx (-Distance
bpy))
                        fp :: Point
fp = Point -> Point -> Point
psub Point
cp (Distance -> Distance -> Point
Point (Distance
bpxDistance -> Distance -> Distance
forall a. Num a => a -> a -> a
+Distance
4) Distance
0)
                        l1 :: Line
l1 = Point -> Point -> Line
Line Point
ap Point
bp
                        l2 :: Line
l2 = Point -> Point -> Line
Line Point
bp Point
cp
                        l3 :: Line
l3 = Point -> Point -> Line
Line Point
cp Point
ap
                        l4 :: Line
l4 = Point -> Point -> Line
Line Point
dp Point
ep
                        l5 :: Line
l5 = Point -> Point -> Line
Line Point
ep Point
fp
                        l6 :: Line
l6 = Point -> Point -> Line
Line Point
fp Point
dp
                        l7 :: Line
l7 = Point -> Point -> Line
Line Point
ap Point
dp
                        l8 :: Line
l8 = Point -> Point -> Line
Line Point
bp Point
ep
                        l9 :: Line
l9 = Point -> Point -> Line
Line Point
cp Point
fp
                        incx :: Point -> Point
incx = Point -> Point -> Point
padd (Distance -> Distance -> Point
Point Distance
1 Distance
0)
                        incy :: Point -> Point
incy = Point -> Point -> Point
padd (Distance -> Distance -> Point
Point Distance
0 Distance
1)
                        decx :: Point -> Point
decx = Point -> Point -> Point
padd (Distance -> Distance -> Point
Point (-Distance
1) Distance
0)
                        decy :: Point -> Point
decy = Point -> Point -> Point
padd (Distance -> Distance -> Point
Point Distance
0 (-Distance
1))
                        tBorderPoints :: [Point]
tBorderPoints = [(Point -> Point
incx (Point -> Point) -> (Point -> Point) -> Point -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Point
incy) Point
ap, Point -> Point
decy Point
bp, Point -> Point
decx Point
cp, (Point -> Point
incx (Point -> Point) -> (Point -> Point) -> Point -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Point
incy) Point
ap, Point
dp, Point
fp, Point
ep, Point
dp]
                        tLowerBorderPoints :: [Point]
tLowerBorderPoints = [Point
ep,Point
bp,Point
cp,Point
fp]
                        trianglePoints :: [Point]
trianglePoints = [Point
ap,Point
bp,Point
cp]
                    in  ((FRequest -> Message FRequest b)
-> [FRequest] -> [Message FRequest b]
forall a b. (a -> b) -> [a] -> [b]
map FRequest -> Message FRequest b
forall a b. a -> Message a b
Low [
                                  GCId -> Shape -> CoordMode -> [Point] -> FRequest
wFillPolygon GCId
extraGC Shape
Nonconvex CoordMode
CoordModeOrigin [Point]
trianglePoints,
                                  GCId -> Shape -> CoordMode -> [Point] -> FRequest
wFillPolygon GCId
drawGC Shape
Nonconvex CoordMode
CoordModeOrigin [Point]
tLowerBorderPoints,
                                  GCId -> Line -> FRequest
wDrawLine GCId
drawGC Line
l1,
                                  GCId -> Line -> FRequest
wDrawLine GCId
drawGC Line
l2,
                                  GCId -> Line -> FRequest
wDrawLine GCId
drawGC Line
l3,
                                  GCId -> Line -> FRequest
wDrawLine GCId
drawGC Line
l4,
                                  GCId -> Line -> FRequest
wDrawLine GCId
drawGC Line
l5,
                                  GCId -> Line -> FRequest
wDrawLine GCId
drawGC Line
l6,
                                  GCId -> Line -> FRequest
wDrawLine GCId
drawGC Line
l7,
                                  GCId -> Line -> FRequest
wDrawLine GCId
drawGC Line
l8,
                                  GCId -> Line -> FRequest
wDrawLine GCId
drawGC Line
l9
                                 ],
                                 [
                                  FRequest -> Message FRequest b
forall a b. a -> Message a b
Low (GCId -> Shape -> CoordMode -> [Point] -> FRequest
wFillPolygon GCId
invertGC Shape
Nonconvex
                                  CoordMode
CoordModeOrigin [Point]
tBorderPoints)
                                 ])
              dRAWC :: Point -> ([Message FRequest b], [Message FRequest b])
dRAWC Point
s =
                    let bpx :: Distance
bpx = Distance
edgew
                        bpy :: Distance
bpy = Distance
edgew
                        upperLeftCorner :: Point
upperLeftCorner = Distance -> Distance -> Point
Point Distance
bpx Distance
bpy
                        size :: Point
size@(Point Distance
sx Distance
sy) = Point -> Point -> Point
psub Point
s (Distance -> Distance -> Point
Point Distance
1 Distance
1)
                        groteRechthoek :: Rect
groteRechthoek = Point -> Point -> Rect
Rect Point
origin Point
size
                        groteRechthoek2 :: Rect
groteRechthoek2 = Point -> Point -> Rect
Rect (Point -> Point -> Point
psub Point
origin (Distance -> Distance -> Point
Point Distance
1 Distance
1)) Point
size
                        kleineRechthoek :: Rect
kleineRechthoek = Point -> Point -> Rect
Rect (Point -> Point -> Point
padd Point
origin (Distance -> Distance -> Point
Point Distance
edgew Distance
edgew)) (Distance -> Distance -> Point
Point (Distance
sxDistance -> Distance -> Distance
forall a. Num a => a -> a -> a
-(Distance
2Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
*Distance
edgew)) (Distance
syDistance -> Distance -> Distance
forall a. Num a => a -> a -> a
-(Distance
2Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
*Distance
edgew)))
                    in  ((FRequest -> Message FRequest b)
-> [FRequest] -> [Message FRequest b]
forall a b. (a -> b) -> [a] -> [b]
map FRequest -> Message FRequest b
forall a b. a -> Message a b
Low [
                                  GCId -> Rect -> Distance -> Distance -> FRequest
wFillArc GCId
extraGC Rect
groteRechthoek (Distance
0Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
*Distance
64) (Distance
360Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
*Distance
64),
                                  GCId -> Rect -> Distance -> Distance -> FRequest
wFillArc GCId
drawGC Rect
groteRechthoek (-Distance
135Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
*Distance
64) (Distance
180Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
*Distance
64),
                                  GCId -> Rect -> Distance -> Distance -> FRequest
wDrawArc GCId
drawGC Rect
groteRechthoek (Distance
0Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
*Distance
64) (Distance
360Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
*Distance
64),
                                  GCId -> Rect -> Distance -> Distance -> FRequest
wFillArc GCId
extraGC Rect
kleineRechthoek (Distance
0Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
*Distance
64) (Distance
360Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
*Distance
64),
                                  GCId -> Rect -> Distance -> Distance -> FRequest
wDrawArc GCId
drawGC Rect
kleineRechthoek (Distance
0Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
*Distance
64) (Distance
360Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
*Distance
64)
                                 ],
                                 [FRequest -> Message FRequest b
forall a b. a -> Message a b
Low (GCId -> Rect -> Distance -> Distance -> FRequest
wFillArc GCId
invertGC Rect
groteRechthoek2 (Distance
0Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
*Distance
64) (Distance
360Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
*Distance
64))])
              proc :: Bool -> Point -> K Bool b
proc Bool
pressed Point
size =
                  Cont (K Bool b) (Message FResponse Bool)
forall hi ho. Cont (K hi ho) (KEvent hi)
getK Cont (K Bool b) (Message FResponse Bool)
-> Cont (K Bool b) (Message FResponse Bool)
forall a b. (a -> b) -> a -> b
$ \Message FResponse Bool
bmsg ->
                  let same :: K Bool b
same = Bool -> Point -> K Bool b
proc Bool
pressed Point
size
                      ([Message FRequest b]
drawit_size, [Message FRequest b]
pressit_size) = case RadioButtonBorderType
bbt of
                                                      RadioButtonBorderType
Square -> Point -> ([Message FRequest b], [Message FRequest b])
forall b b. Point -> ([Message FRequest b], [Message FRequest b])
dRAWS Point
size
                                                      RadioButtonBorderType
Triangle -> Point -> ([Message FRequest b], [Message FRequest b])
forall b b. Point -> ([Message FRequest b], [Message FRequest b])
dRAWT Point
size
                                                      RadioButtonBorderType
Circle -> Point -> ([Message FRequest b], [Message FRequest b])
forall b b. Point -> ([Message FRequest b], [Message FRequest b])
dRAWC Point
size
                      redraw :: Bool -> [Message FRequest b]
redraw Bool
b = if (Bool
b Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
pressed) then [] else [Message FRequest b]
forall b. [Message FRequest b]
pressit_size
                  in  case Message FResponse Bool
bmsg of
                        Low (XEvt (Expose Rect
_ Distance
0)) -> [KCommand b] -> K Bool b -> K Bool b
forall b a. [KCommand b] -> K a b -> K a b
putsK ([KCommand b]
forall b. [Message FRequest b]
drawit_size [KCommand b] -> [KCommand b] -> [KCommand b]
forall a. [a] -> [a] -> [a]
++
                            (if Bool
pressed then [KCommand b]
forall b. [Message FRequest b]
pressit_size else [])) K Bool b
same
                        Low (LEvt (LayoutSize Point
newsize)) -> Bool -> Point -> K Bool b
proc Bool
pressed Point
newsize
                        High Bool
change -> [KCommand b] -> K Bool b -> K Bool b
forall b a. [KCommand b] -> K a b -> K a b
putsK (Bool -> [KCommand b]
forall b. Bool -> [Message FRequest b]
redraw Bool
change) (Bool -> Point -> K Bool b
proc Bool
change Point
size)
                        Message FResponse Bool
_ -> K Bool b
same
              proc0 :: Bool -> K Bool ho
proc0 Bool
pressed =
                  Cont (K Bool ho) (Message FResponse Bool)
forall hi ho. Cont (K hi ho) (KEvent hi)
getK Cont (K Bool ho) (Message FResponse Bool)
-> Cont (K Bool ho) (Message FResponse Bool)
forall a b. (a -> b) -> a -> b
$ \Message FResponse Bool
msg ->
                  case Message FResponse Bool
msg of
                    Low (LEvt (LayoutSize Point
size)) -> Bool -> Point -> K Bool ho
forall b. Bool -> Point -> K Bool b
proc Bool
pressed Point
size
                    High Bool
change -> Bool -> K Bool ho
proc0 Bool
change
                    Message FResponse Bool
_ -> Bool -> K Bool ho
proc0 Bool
pressed
          in  Bool -> K Bool ho
forall ho. Bool -> K Bool ho
proc0 Bool
False

        startcmds :: [FRequest]
startcmds =
          [XCommand -> FRequest
XCmd (XCommand -> FRequest) -> XCommand -> FRequest
forall a b. (a -> b) -> a -> b
$ [WindowChanges] -> XCommand
ConfigureWindow [Distance -> WindowChanges
CWBorderWidth Distance
0],
           XCommand -> FRequest
XCmd (XCommand -> FRequest) -> XCommand -> FRequest
forall a b. (a -> b) -> a -> b
$ [WindowAttributes] -> XCommand
ChangeWindowAttributes [[EventMask] -> WindowAttributes
CWEventMask [EventMask
ExposureMask]]]
    in  Either b b -> b
forall p. Either p p -> p
stripEither (Either b b -> b)
-> F (Either Bool c) (Either b b) -> F (Either Bool c) b
forall a b e. (a -> b) -> F e a -> F e b
>^=< ((([FRequest] -> K Bool b -> F c b -> F (Either Bool c) (Either b b)
forall a b c d.
[FRequest] -> K a b -> F c d -> F (Either a c) (Either b d)
groupF [FRequest]
startcmds (FontName -> K Bool b -> K Bool b
forall a b. FontName -> K a b -> K a b
changeBg FontName
bgColor K Bool b
forall ho. K Bool ho
kernel)) (F c b -> F (Either Bool c) (Either b b))
-> (F c b -> F c b) -> F c b -> F (Either Bool c) (Either b b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Distance -> F c b -> F c b
forall a b. Distance -> F a b -> F a b
marginF (Distance
edgew Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
+ Distance
1)) F c b
f)