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 [] 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 []
((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 []
((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)