module Color(tryAllocColor,tryAllocColorF,
allocColor,allocColorF,
allocColorPixel,allocColorPixelF,
tryAllocNamedColor,tryAllocNamedColorF,
allocNamedColor,allocNamedColorF,
allocNamedColorPixel,allocNamedColorPixelF,
allocNamedColorDef,
allocNamedColorDefPixel,
queryColor,queryColorF
) where
import Command
import Event
import Xrequest
import Xtypes
import Cont
import StdIoUtil(echoStderrK)
genTryAlloc :: t -> (t -> (XResponse -> Maybe (Maybe Color)) -> t) -> t
genTryAlloc t
cmd t -> (XResponse -> Maybe (Maybe Color)) -> t
xr =
let expected :: XResponse -> Maybe (Maybe Color)
expected (ColorAllocated Maybe Color
color) = Maybe Color -> Maybe (Maybe Color)
forall a. a -> Maybe a
Just Maybe Color
color
expected XResponse
_ = Maybe (Maybe Color)
forall a. Maybe a
Nothing
in t -> (XResponse -> Maybe (Maybe Color)) -> t
xr t
cmd XResponse -> Maybe (Maybe Color)
expected
genTryAllocColor :: (XRequest -> (XResponse -> Maybe (Maybe Color)) -> t)
-> ColormapId -> RGB -> t
genTryAllocColor XRequest -> (XResponse -> Maybe (Maybe Color)) -> t
xr ColormapId
cmap RGB
rgb = XRequest
-> (XRequest -> (XResponse -> Maybe (Maybe Color)) -> t) -> t
forall t t.
t -> (t -> (XResponse -> Maybe (Maybe Color)) -> t) -> t
genTryAlloc (ColormapId -> RGB -> XRequest
AllocColor ColormapId
cmap RGB
rgb) XRequest -> (XResponse -> Maybe (Maybe Color)) -> t
xr
genTryAllocNamedColor :: (XRequest -> (XResponse -> Maybe (Maybe Color)) -> t)
-> ColormapId -> ColorName -> t
genTryAllocNamedColor XRequest -> (XResponse -> Maybe (Maybe Color)) -> t
xr ColormapId
cmap ColorName
cname = XRequest
-> (XRequest -> (XResponse -> Maybe (Maybe Color)) -> t) -> t
forall t t.
t -> (t -> (XResponse -> Maybe (Maybe Color)) -> t) -> t
genTryAlloc (ColormapId -> ColorName -> XRequest
AllocNamedColor ColormapId
cmap ColorName
cname) XRequest -> (XResponse -> Maybe (Maybe Color)) -> t
xr
tryAllocColor :: ColormapId -> RGB -> (Maybe Color -> f b ho) -> f b ho
tryAllocColor ColormapId
x = (XRequest
-> (XResponse -> Maybe (Maybe Color))
-> (Maybe Color -> f b ho)
-> f b ho)
-> ColormapId -> RGB -> (Maybe Color -> f b ho) -> f b ho
forall t.
(XRequest -> (XResponse -> Maybe (Maybe Color)) -> t)
-> ColormapId -> RGB -> t
genTryAllocColor XRequest
-> (XResponse -> Maybe (Maybe Color))
-> (Maybe Color -> f b ho)
-> f b ho
forall (f :: * -> * -> *) ans b ho.
FudgetIO f =>
XRequest -> (XResponse -> Maybe ans) -> (ans -> f b ho) -> f b ho
xrequest ColormapId
x
tryAllocColorF :: ColormapId -> RGB -> Cont (F b c) (Maybe Color)
tryAllocColorF = (XRequest
-> (XResponse -> Maybe (Maybe Color))
-> Cont (F b c) (Maybe Color))
-> ColormapId -> RGB -> Cont (F b c) (Maybe Color)
forall t.
(XRequest -> (XResponse -> Maybe (Maybe Color)) -> t)
-> ColormapId -> RGB -> t
genTryAllocColor XRequest
-> (XResponse -> Maybe (Maybe Color)) -> Cont (F b c) (Maybe Color)
forall a b c. XRequest -> (XResponse -> Maybe a) -> Cont (F b c) a
xrequestF
tryAllocNamedColor :: ColormapId -> ColorName -> (Maybe Color -> f b ho) -> f b ho
tryAllocNamedColor ColormapId
x = (XRequest
-> (XResponse -> Maybe (Maybe Color))
-> (Maybe Color -> f b ho)
-> f b ho)
-> ColormapId -> ColorName -> (Maybe Color -> f b ho) -> f b ho
forall t.
(XRequest -> (XResponse -> Maybe (Maybe Color)) -> t)
-> ColormapId -> ColorName -> t
genTryAllocNamedColor XRequest
-> (XResponse -> Maybe (Maybe Color))
-> (Maybe Color -> f b ho)
-> f b ho
forall (f :: * -> * -> *) ans b ho.
FudgetIO f =>
XRequest -> (XResponse -> Maybe ans) -> (ans -> f b ho) -> f b ho
xrequest ColormapId
x
tryAllocNamedColorF :: ColormapId -> ColorName -> Cont (F b c) (Maybe Color)
tryAllocNamedColorF = (XRequest
-> (XResponse -> Maybe (Maybe Color))
-> Cont (F b c) (Maybe Color))
-> ColormapId -> ColorName -> Cont (F b c) (Maybe Color)
forall t.
(XRequest -> (XResponse -> Maybe (Maybe Color)) -> t)
-> ColormapId -> ColorName -> t
genTryAllocNamedColor XRequest
-> (XResponse -> Maybe (Maybe Color)) -> Cont (F b c) (Maybe Color)
forall a b c. XRequest -> (XResponse -> Maybe a) -> Cont (F b c) a
xrequestF
allocNamedColorDef :: ColormapId -> ColorName -> ColorName -> Cont (f b ho) Color
allocNamedColorDef ColormapId
cmap ColorName
cname ColorName
fallback =
Cont (f b ho) (Maybe Color)
-> Cont (f b ho) Color -> Cont (f b ho) Color
forall c a. Cont c (Maybe a) -> Cont c a -> Cont c a
tryGet (ColormapId -> ColorName -> Cont (f b ho) (Maybe Color)
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
ColormapId -> ColorName -> (Maybe Color -> f b ho) -> f b ho
tryAllocNamedColor ColormapId
cmap ColorName
cname)
(ColorName -> f b ho -> f b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
ColorName -> f b ho -> f b ho
echoStderrK
(ColorName
"Warning, cannot allocate background color \""ColorName -> ColorName -> ColorName
forall a. [a] -> [a] -> [a]
++ColorName
cnameColorName -> ColorName -> ColorName
forall a. [a] -> [a] -> [a]
++
ColorName
"\", using \""ColorName -> ColorName -> ColorName
forall a. [a] -> [a] -> [a]
++ColorName
fallbackColorName -> ColorName -> ColorName
forall a. [a] -> [a] -> [a]
++ColorName
"\" instead.") (f b ho -> f b ho) -> Cont (f b ho) Color -> Cont (f b ho) Color
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
ColormapId -> ColorName -> Cont (f b ho) Color
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
ColormapId -> ColorName -> Cont (f b ho) Color
allocNamedColor ColormapId
cmap ColorName
fallback)
allocNamedColorDefPixel :: ColormapId -> ColorName -> ColorName -> (Pixel -> f b ho) -> f b ho
allocNamedColorDefPixel ColormapId
cmap ColorName
cname ColorName
fallback = ColormapId -> ColorName -> ColorName -> Cont (f b ho) Color
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
ColormapId -> ColorName -> ColorName -> Cont (f b ho) Color
allocNamedColorDef ColormapId
cmap ColorName
cname ColorName
fallback
Cont (f b ho) Color
-> ((Pixel -> f b ho) -> Color -> f b ho)
-> (Pixel -> f b ho)
-> f b ho
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Pixel -> f b ho) -> (Color -> Pixel) -> Color -> f b ho
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> Pixel
colorPixel)
safe :: (t -> a -> Cont c (Maybe a)) -> t -> a -> Cont c a
safe t -> a -> Cont c (Maybe a)
req t
cmap a
c = Cont c (Maybe a) -> c -> Cont c a
forall c a. Cont c (Maybe a) -> c -> Cont c a
tryM (t -> a -> Cont c (Maybe a)
req t
cmap a
c) (ColorName -> c
forall a. HasCallStack => ColorName -> a
error (ColorName
"Cannot allocate color: "ColorName -> ColorName -> ColorName
forall a. [a] -> [a] -> [a]
++a -> ColorName
forall a. Show a => a -> ColorName
show a
c))
pixel :: (a->b->Cont c Color) -> a->b->Cont c Pixel
pixel :: (a -> b -> Cont c Color) -> a -> b -> Cont c Pixel
pixel a -> b -> Cont c Color
req a
cmap b
c = a -> b -> Cont c Color
req a
cmap b
c Cont c Color -> ((Pixel -> c) -> Color -> c) -> Cont c Pixel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Pixel -> c) -> (Color -> Pixel) -> Color -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> Pixel
colorPixel)
allocNamedColor :: ColormapId -> ColorName -> Cont (f b ho) Color
allocNamedColor ColormapId
x = (ColormapId -> ColorName -> Cont (f b ho) (Maybe Color))
-> ColormapId -> ColorName -> Cont (f b ho) Color
forall a t c a.
Show a =>
(t -> a -> Cont c (Maybe a)) -> t -> a -> Cont c a
safe ColormapId -> ColorName -> Cont (f b ho) (Maybe Color)
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
ColormapId -> ColorName -> (Maybe Color -> f b ho) -> f b ho
tryAllocNamedColor ColormapId
x
allocNamedColorF :: ColormapId -> ColorName -> Cont (F b c) Color
allocNamedColorF = (ColormapId -> ColorName -> Cont (F b c) (Maybe Color))
-> ColormapId -> ColorName -> Cont (F b c) Color
forall a t c a.
Show a =>
(t -> a -> Cont c (Maybe a)) -> t -> a -> Cont c a
safe ColormapId -> ColorName -> Cont (F b c) (Maybe Color)
forall b c. ColormapId -> ColorName -> Cont (F b c) (Maybe Color)
tryAllocNamedColorF
allocNamedColorPixel :: ColormapId -> ColorName -> Cont (f b ho) Pixel
allocNamedColorPixel ColormapId
x = (ColormapId -> ColorName -> Cont (f b ho) Color)
-> ColormapId -> ColorName -> Cont (f b ho) Pixel
forall a b c. (a -> b -> Cont c Color) -> a -> b -> Cont c Pixel
pixel ColormapId -> ColorName -> Cont (f b ho) Color
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
ColormapId -> ColorName -> Cont (f b ho) Color
allocNamedColor ColormapId
x
allocNamedColorPixelF :: ColormapId -> ColorName -> Cont (F b c) Pixel
allocNamedColorPixelF = (ColormapId -> ColorName -> Cont (F b c) Color)
-> ColormapId -> ColorName -> Cont (F b c) Pixel
forall a b c. (a -> b -> Cont c Color) -> a -> b -> Cont c Pixel
pixel ColormapId -> ColorName -> Cont (F b c) Color
forall b c. ColormapId -> ColorName -> Cont (F b c) Color
allocNamedColorF
allocColor :: ColormapId -> RGB -> Cont (f b ho) Color
allocColor ColormapId
x = (ColormapId -> RGB -> Cont (f b ho) (Maybe Color))
-> ColormapId -> RGB -> Cont (f b ho) Color
forall a t c a.
Show a =>
(t -> a -> Cont c (Maybe a)) -> t -> a -> Cont c a
safe ColormapId -> RGB -> Cont (f b ho) (Maybe Color)
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
ColormapId -> RGB -> (Maybe Color -> f b ho) -> f b ho
tryAllocColor ColormapId
x
allocColorF :: ColormapId -> RGB -> Cont (F b c) Color
allocColorF = (ColormapId -> RGB -> Cont (F b c) (Maybe Color))
-> ColormapId -> RGB -> Cont (F b c) Color
forall a t c a.
Show a =>
(t -> a -> Cont c (Maybe a)) -> t -> a -> Cont c a
safe ColormapId -> RGB -> Cont (F b c) (Maybe Color)
forall b c. ColormapId -> RGB -> Cont (F b c) (Maybe Color)
tryAllocColorF
allocColorPixel :: ColormapId -> RGB -> Cont (f b ho) Pixel
allocColorPixel ColormapId
x = (ColormapId -> RGB -> Cont (f b ho) Color)
-> ColormapId -> RGB -> Cont (f b ho) Pixel
forall a b c. (a -> b -> Cont c Color) -> a -> b -> Cont c Pixel
pixel ColormapId -> RGB -> Cont (f b ho) Color
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
ColormapId -> RGB -> Cont (f b ho) Color
allocColor ColormapId
x
allocColorPixelF :: ColormapId -> RGB -> Cont (F b c) Pixel
allocColorPixelF = (ColormapId -> RGB -> Cont (F b c) Color)
-> ColormapId -> RGB -> Cont (F b c) Pixel
forall a b c. (a -> b -> Cont c Color) -> a -> b -> Cont c Pixel
pixel ColormapId -> RGB -> Cont (F b c) Color
forall b c. ColormapId -> RGB -> Cont (F b c) Color
allocColorF
querycolor :: (XRequest -> (XResponse -> Maybe Color) -> t)
-> ColormapId -> Pixel -> t
querycolor XRequest -> (XResponse -> Maybe Color) -> t
xr ColormapId
cmap Pixel
pixel =
let expected :: XResponse -> Maybe Color
expected (ColorQueried Color
c) = Color -> Maybe Color
forall a. a -> Maybe a
Just Color
c
expected XResponse
_ = Maybe Color
forall a. Maybe a
Nothing
in XRequest -> (XResponse -> Maybe Color) -> t
xr (ColormapId -> Pixel -> XRequest
QueryColor ColormapId
cmap Pixel
pixel) XResponse -> Maybe Color
expected
queryColorF :: ColormapId -> Pixel -> Cont (F b c) Color
queryColorF = (XRequest -> (XResponse -> Maybe Color) -> Cont (F b c) Color)
-> ColormapId -> Pixel -> Cont (F b c) Color
forall t.
(XRequest -> (XResponse -> Maybe Color) -> t)
-> ColormapId -> Pixel -> t
querycolor XRequest -> (XResponse -> Maybe Color) -> Cont (F b c) Color
forall a b c. XRequest -> (XResponse -> Maybe a) -> Cont (F b c) a
xrequestF
queryColor :: ColormapId -> Pixel -> (Color -> f b ho) -> f b ho
queryColor ColormapId
x = (XRequest
-> (XResponse -> Maybe Color) -> (Color -> f b ho) -> f b ho)
-> ColormapId -> Pixel -> (Color -> f b ho) -> f b ho
forall t.
(XRequest -> (XResponse -> Maybe Color) -> t)
-> ColormapId -> Pixel -> t
querycolor XRequest
-> (XResponse -> Maybe Color) -> (Color -> f b ho) -> f b ho
forall (f :: * -> * -> *) ans b ho.
FudgetIO f =>
XRequest -> (XResponse -> Maybe ans) -> (ans -> f b ho) -> f b ho
xrequest ColormapId
x