module GreyBgF(changeBg, darkGreyBgK, lightGreyBgK, greyBgK, knobBgK, changeBackPixmap) where
import BgF(changeBackPixel)
import Color
import Command
import XDraw
--import Event(XEvent,BitmapReturn)
import Fudget
--import FudgetIO
import Xcommand
import Gc
import Geometry(Rect(..), lL, pP)
--import LayoutRequest(LayoutRequest)
--import Message(Message(..))
--import NullF
import Pixmap
import Cont(tryM)
import Xtypes
import GCAttrs(convColorK) -- + instances

--changeBackPixmap :: ColorName -> ColorName -> Size -> [DrawCommand] -> (K a b) -> K a b
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 [{-GCFunction GXcopy,-}
                      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