module GreyBgF(changeBg, darkGreyBgK, lightGreyBgK, greyBgK, knobBgK, changeBackPixmap) where
import BgF(changeBackPixel)
import Color
import Command
import XDraw
import Fudget
import Xcommand
import Gc
import Geometry(Rect(..), lL, pP)
import Pixmap
import Cont(tryM)
import Xtypes
import GCAttrs(convColorK)
changeBackPixmap :: a -> a -> Point -> [DrawCommand] -> K i o -> K i o
changeBackPixmap a
fgcol a
bgcol Point
size [DrawCommand]
draw K i o
f =
a -> (Pixel -> K i o) -> K i o
forall a (f :: * -> * -> *) i o.
(ColorGen a, FudgetIO f, Show a) =>
a -> (Pixel -> f i o) -> f i o
convColorK a
fgcol ((Pixel -> K i o) -> K i o) -> (Pixel -> K i o) -> K i o
forall a b. (a -> b) -> a -> b
$ \Pixel
fg ->
a -> (Pixel -> K i o) -> K i o
forall a (f :: * -> * -> *) i o.
(ColorGen a, FudgetIO f, Show a) =>
a -> (Pixel -> f i o) -> f i o
convColorK a
bgcol ((Pixel -> K i o) -> K i o) -> (Pixel -> K i o) -> K i o
forall a b. (a -> b) -> a -> b
$ \Pixel
bg ->
Pixel -> Pixel -> Point -> [DrawCommand] -> K i o -> K i o
forall b ho.
Pixel -> Pixel -> Point -> [DrawCommand] -> K b ho -> K b ho
changeBackPixmapCol Pixel
fg Pixel
bg Point
size [DrawCommand]
draw K i o
f
changeBackPixmapCol :: Pixel -> Pixel -> Point -> [DrawCommand] -> K b ho -> K b ho
changeBackPixmapCol Pixel
fg Pixel
bg Point
size [DrawCommand]
draw K b ho
f =
Point -> Int -> (PixmapId -> K b ho) -> K b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
Point -> Int -> (PixmapId -> f b ho) -> f b ho
createPixmap Point
size Int
copyFromParent ((PixmapId -> K b ho) -> K b ho) -> (PixmapId -> K b ho) -> K b ho
forall a b. (a -> b) -> a -> b
$ \PixmapId
pm ->
GCId -> [GCAttributes Pixel FontId] -> (GCId -> K b ho) -> K b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
GCId -> [GCAttributes Pixel FontId] -> (GCId -> f b ho) -> f b ho
wCreateGC GCId
rootGC [
Pixel -> GCAttributes Pixel FontId
forall a b. a -> GCAttributes a b
GCForeground Pixel
fg, Pixel -> GCAttributes Pixel FontId
forall a b. a -> GCAttributes a b
GCBackground Pixel
bg,
Bool -> GCAttributes Pixel FontId
forall a b. Bool -> GCAttributes a b
GCGraphicsExposures Bool
False] ((GCId -> K b ho) -> K b ho) -> (GCId -> K b ho) -> K b ho
forall a b. (a -> b) -> a -> b
$ \GCId
gc ->
GCId -> [GCAttributes Pixel FontId] -> (GCId -> K b ho) -> K b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
GCId -> [GCAttributes Pixel FontId] -> (GCId -> f b ho) -> f b ho
wCreateGC GCId
gc [Pixel -> GCAttributes Pixel FontId
forall a b. a -> GCAttributes a b
GCForeground Pixel
bg] ((GCId -> K b ho) -> K b ho) -> (GCId -> K b ho) -> K b ho
forall a b. (a -> b) -> a -> b
$ \GCId
gcbg ->
[XCommand] -> K b ho -> K b ho
forall i o. [XCommand] -> K i o -> K i o
xcommandsK [Drawable -> [(GCId, [DrawCommand])] -> XCommand
DrawMany (PixmapId -> Drawable
Pixmap PixmapId
pm)
[(GCId
gcbg,[Rect -> DrawCommand
FillRectangle (Point -> Point -> Rect
Rect (Int -> Int -> Point
pP Int
0 Int
0) Point
size)]),
(GCId
gc, [DrawCommand]
draw)],
[WindowAttributes] -> XCommand
ChangeWindowAttributes [PixmapId -> WindowAttributes
CWBackPixmap PixmapId
pm],
XCommand
clearWindowExpose,
PixmapId -> XCommand
FreePixmap PixmapId
pm]
K b ho
f
knobBgK :: K b ho -> K b ho
knobBgK K b ho
cont =
ColorName -> ColorName -> (Color -> K b ho) -> K b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
ColorName -> ColorName -> (Color -> f b ho) -> f b ho
try2 ColorName
"grey33" ColorName
"black" ((Color -> K b ho) -> K b ho) -> (Color -> K b ho) -> K b ho
forall a b. (a -> b) -> a -> b
$ \ (Color Pixel
fg RGB
_) ->
ColorName -> ColorName -> (Color -> K b ho) -> K b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
ColorName -> ColorName -> (Color -> f b ho) -> f b ho
try2 ColorName
"grey" ColorName
"white" ((Color -> K b ho) -> K b ho) -> (Color -> K b ho) -> K b ho
forall a b. (a -> b) -> a -> b
$ \ (Color Pixel
bg RGB
_) ->
Pixel -> Pixel -> Point -> [DrawCommand] -> K b ho -> K b ho
forall b ho.
Pixel -> Pixel -> Point -> [DrawCommand] -> K b ho -> K b ho
changeBackPixmapCol Pixel
fg Pixel
bg (Int -> Int -> Point
pP Int
8 Int
8)
[Line -> DrawCommand
DrawLine (Int -> Int -> Int -> Int -> Line
lL Int
0 Int
0 Int
2 Int
2), Line -> DrawCommand
DrawLine (Int -> Int -> Int -> Int -> Line
lL Int
4 Int
6 Int
6 Int
4)] K b ho
cont
dithered50BgK :: Pixel -> Pixel -> K b ho -> K b ho
dithered50BgK Pixel
fg Pixel
bg =
Pixel -> Pixel -> Point -> [DrawCommand] -> K b ho -> K b ho
forall b ho.
Pixel -> Pixel -> Point -> [DrawCommand] -> K b ho -> K b ho
changeBackPixmapCol Pixel
fg Pixel
bg (Int -> Int -> Point
pP Int
2 Int
2) [Line -> DrawCommand
DrawLine (Int -> Int -> Int -> Int -> Line
lL Int
0 Int
0 Int
1 Int
1)]
dithered25BgK :: Pixel -> Pixel -> K b ho -> K b ho
dithered25BgK Pixel
fg Pixel
bg =
Pixel -> Pixel -> Point -> [DrawCommand] -> K b ho -> K b ho
forall b ho.
Pixel -> Pixel -> Point -> [DrawCommand] -> K b ho -> K b ho
changeBackPixmapCol Pixel
fg Pixel
bg (Int -> Int -> Point
pP Int
2 Int
2) [Line -> DrawCommand
DrawLine (Int -> Int -> Int -> Int -> Line
lL Int
0 Int
0 Int
0 Int
0)]
dithered75BgK :: Pixel -> Pixel -> K b ho -> K b ho
dithered75BgK Pixel
fg Pixel
bg = Pixel -> Pixel -> K b ho -> K b ho
forall b ho. Pixel -> Pixel -> K b ho -> K b ho
dithered25BgK Pixel
bg Pixel
fg
trySolidGreyBgK :: ColorName
-> (Pixel -> Pixel -> K b ho -> K b ho) -> K b ho -> K b ho
trySolidGreyBgK ColorName
cname Pixel -> Pixel -> K b ho -> K b ho
dithK K b ho
cont =
ColorName -> (Color -> Color -> Color -> K b ho) -> K b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
ColorName -> (Color -> Color -> Color -> f b ho) -> f b ho
alloc3 ColorName
cname ((Color -> Color -> Color -> K b ho) -> K b ho)
-> (Color -> Color -> Color -> K b ho) -> K b ho
forall a b. (a -> b) -> a -> b
$ \ (Color Pixel
black RGB
b) (Color Pixel
white RGB
w) (Color Pixel
gray RGB
g) ->
if RGB
gRGB -> RGB -> Bool
forall a. Eq a => a -> a -> Bool
==RGB
b Bool -> Bool -> Bool
|| RGB
gRGB -> RGB -> Bool
forall a. Eq a => a -> a -> Bool
==RGB
w
then Pixel -> Pixel -> K b ho -> K b ho
dithK Pixel
white Pixel
black K b ho
cont
else [XCommand] -> K b ho -> K b ho
forall i o. [XCommand] -> K i o -> K i o
xcommandsK [[WindowAttributes] -> XCommand
ChangeWindowAttributes [Pixel -> WindowAttributes
CWBackPixel Pixel
gray],
XCommand
clearWindowExpose] (K b ho -> K b ho) -> K b ho -> K b ho
forall a b. (a -> b) -> a -> b
$
K b ho
cont
greyBgK :: K b ho -> K b ho
greyBgK = ColorName
-> (Pixel -> Pixel -> K b ho -> K b ho) -> K b ho -> K b ho
forall b ho.
ColorName
-> (Pixel -> Pixel -> K b ho -> K b ho) -> K b ho -> K b ho
trySolidGreyBgK ColorName
"grey" Pixel -> Pixel -> K b ho -> K b ho
forall b ho. Pixel -> Pixel -> K b ho -> K b ho
dithered50BgK
darkGreyBgK :: K b ho -> K b ho
darkGreyBgK = ColorName
-> (Pixel -> Pixel -> K b ho -> K b ho) -> K b ho -> K b ho
forall b ho.
ColorName
-> (Pixel -> Pixel -> K b ho -> K b ho) -> K b ho -> K b ho
trySolidGreyBgK ColorName
"dark grey" Pixel -> Pixel -> K b ho -> K b ho
forall b ho. Pixel -> Pixel -> K b ho -> K b ho
dithered25BgK
lightGreyBgK :: K b ho -> K b ho
lightGreyBgK = ColorName
-> (Pixel -> Pixel -> K b ho -> K b ho) -> K b ho -> K b ho
forall b ho.
ColorName
-> (Pixel -> Pixel -> K b ho -> K b ho) -> K b ho -> K b ho
trySolidGreyBgK ColorName
"light grey" Pixel -> Pixel -> K b ho -> K b ho
forall b ho. Pixel -> Pixel -> K b ho -> K b ho
dithered75BgK
changeBg :: ColorName -> (K a b) -> K a b
changeBg :: ColorName -> K a b -> K a b
changeBg ColorName
bg =
case ColorName
bg of
ColorName
"Nothing" -> K a b -> K a b
forall a. a -> a
id
ColorName
"grey" -> K a b -> K a b
forall b ho. K b ho -> K b ho
greyBgK
ColorName
_ -> ColorName -> K a b -> K a b
forall a i o. (Show a, ColorGen a) => a -> K i o -> K i o
changeBackPixel ColorName
bg
alloc3 :: ColorName -> (Color -> Color -> Color -> f b ho) -> f b ho
alloc3 ColorName
colorname Color -> Color -> Color -> f b ho
cont =
ColormapId -> ColorName -> Cont (f b ho) Color
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
ColormapId -> ColorName -> Cont (f b ho) Color
allocNamedColor ColormapId
defaultColormap ColorName
"black" Cont (f b ho) Color -> Cont (f b ho) Color
forall a b. (a -> b) -> a -> b
$ \Color
black ->
ColormapId -> ColorName -> Cont (f b ho) Color
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
ColormapId -> ColorName -> Cont (f b ho) Color
allocNamedColor ColormapId
defaultColormap ColorName
"white" Cont (f b ho) Color -> Cont (f b ho) Color
forall a b. (a -> b) -> a -> b
$ \Color
white ->
ColormapId -> ColorName -> (Maybe Color -> f b ho) -> f b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
ColormapId -> ColorName -> (Maybe Color -> f b ho) -> f b ho
tryAllocNamedColor ColormapId
defaultColormap ColorName
colorname ((Maybe Color -> f b ho) -> f b ho)
-> (Maybe Color -> f b ho) -> f b ho
forall a b. (a -> b) -> a -> b
$ \ Maybe Color
ocolor ->
let color :: Color
color = case Maybe Color
ocolor of
Maybe Color
Nothing -> Color
black
Just Color
c -> Color
c in
Color -> Color -> Color -> f b ho
cont Color
black Color
white Color
color
try2 :: ColorName -> ColorName -> (Color -> f b ho) -> f b ho
try2 ColorName
cname1 ColorName
cname2 Color -> f b ho
cont =
Cont (f b ho) (Maybe Color)
-> f b ho -> (Color -> f b ho) -> f b ho
forall c a. Cont c (Maybe a) -> c -> Cont c a
tryM (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
defaultColormap ColorName
cname1)
(ColormapId -> ColorName -> (Color -> f b ho) -> f b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
ColormapId -> ColorName -> Cont (f b ho) Color
allocNamedColor ColormapId
defaultColormap ColorName
cname2 Color -> f b ho
cont)
Color -> f b ho
cont