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 -> Size -> [DrawCommand] -> K i o -> K i o
changeBackPixmap a
fgcol a
bgcol Size
size [DrawCommand]
draw K i o
f =
    forall {a} {f :: * -> * -> *} {i} {o}.
(ColorGen a, FudgetIO f, Show a) =>
a -> (Pixel -> f i o) -> f i o
convColorK a
fgcol forall a b. (a -> b) -> a -> b
$ \Pixel
fg ->
    forall {a} {f :: * -> * -> *} {i} {o}.
(ColorGen a, FudgetIO f, Show a) =>
a -> (Pixel -> f i o) -> f i o
convColorK a
bgcol forall a b. (a -> b) -> a -> b
$ \Pixel
bg ->
    forall {hi} {ho}.
Pixel -> Pixel -> Size -> [DrawCommand] -> K hi ho -> K hi ho
changeBackPixmapCol Pixel
fg Pixel
bg Size
size [DrawCommand]
draw K i o
f

changeBackPixmapCol :: Pixel -> Pixel -> Size -> [DrawCommand] -> K hi ho -> K hi ho
changeBackPixmapCol Pixel
fg Pixel
bg Size
size [DrawCommand]
draw K hi ho
f =
    forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
Size -> Depth -> (PixmapId -> f hi ho) -> f hi ho
createPixmap Size
size Depth
copyFromParent forall a b. (a -> b) -> a -> b
$ \PixmapId
pm ->
    forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
GCId -> GCAttributeList -> (GCId -> f hi ho) -> f hi ho
wCreateGC GCId
rootGC [{-GCFunction GXcopy,-}
                      forall a b. a -> GCAttributes a b
GCForeground Pixel
fg, forall a b. a -> GCAttributes a b
GCBackground Pixel
bg,
		      forall a b. Bool -> GCAttributes a b
GCGraphicsExposures Bool
False] forall a b. (a -> b) -> a -> b
$ \GCId
gc ->
    forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
GCId -> GCAttributeList -> (GCId -> f hi ho) -> f hi ho
wCreateGC GCId
gc [forall a b. a -> GCAttributes a b
GCForeground Pixel
bg] forall a b. (a -> b) -> a -> b
$ \GCId
gcbg ->
    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 (Size -> Size -> Rect
Rect (Depth -> Depth -> Size
pP Depth
0 Depth
0) Size
size)]),
		   (GCId
gc, [DrawCommand]
draw)],
		[WindowAttributes] -> XCommand
ChangeWindowAttributes [PixmapId -> WindowAttributes
CWBackPixmap PixmapId
pm],
		XCommand
clearWindowExpose,
		PixmapId -> XCommand
FreePixmap PixmapId
pm]
    K hi ho
f

knobBgK :: K hi ho -> K hi ho
knobBgK K hi ho
cont =
    forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
ColorName -> ColorName -> (Color -> f hi ho) -> f hi ho
try2 ColorName
"grey33" ColorName
"black" forall a b. (a -> b) -> a -> b
$ \ (Color Pixel
fg RGB
_) ->
    forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
ColorName -> ColorName -> (Color -> f hi ho) -> f hi ho
try2 ColorName
"grey" ColorName
"white" forall a b. (a -> b) -> a -> b
$ \ (Color Pixel
bg  RGB
_) ->
    forall {hi} {ho}.
Pixel -> Pixel -> Size -> [DrawCommand] -> K hi ho -> K hi ho
changeBackPixmapCol Pixel
fg Pixel
bg (Depth -> Depth -> Size
pP Depth
8 Depth
8)
                        [Line -> DrawCommand
DrawLine (Depth -> Depth -> Depth -> Depth -> Line
lL Depth
0 Depth
0 Depth
2 Depth
2), Line -> DrawCommand
DrawLine (Depth -> Depth -> Depth -> Depth -> Line
lL Depth
4 Depth
6 Depth
6 Depth
4)] K hi ho
cont

dithered50BgK :: Pixel -> Pixel -> K hi ho -> K hi ho
dithered50BgK Pixel
fg Pixel
bg =
  forall {hi} {ho}.
Pixel -> Pixel -> Size -> [DrawCommand] -> K hi ho -> K hi ho
changeBackPixmapCol Pixel
fg Pixel
bg (Depth -> Depth -> Size
pP Depth
2 Depth
2) [Line -> DrawCommand
DrawLine (Depth -> Depth -> Depth -> Depth -> Line
lL Depth
0 Depth
0 Depth
1 Depth
1)]

dithered25BgK :: Pixel -> Pixel -> K hi ho -> K hi ho
dithered25BgK Pixel
fg Pixel
bg =
  forall {hi} {ho}.
Pixel -> Pixel -> Size -> [DrawCommand] -> K hi ho -> K hi ho
changeBackPixmapCol Pixel
fg Pixel
bg (Depth -> Depth -> Size
pP Depth
2 Depth
2) [Line -> DrawCommand
DrawLine (Depth -> Depth -> Depth -> Depth -> Line
lL Depth
0 Depth
0 Depth
0 Depth
0)]

dithered75BgK :: Pixel -> Pixel -> K hi ho -> K hi ho
dithered75BgK Pixel
fg Pixel
bg = forall {hi} {ho}. Pixel -> Pixel -> K hi ho -> K hi ho
dithered25BgK Pixel
bg Pixel
fg

trySolidGreyBgK :: ColorName
-> (Pixel -> Pixel -> K hi ho -> K hi ho) -> K hi ho -> K hi ho
trySolidGreyBgK ColorName
cname Pixel -> Pixel -> K hi ho -> K hi ho
dithK K hi ho
cont =
  forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
ColorName -> (Color -> Color -> Color -> f hi ho) -> f hi ho
alloc3 ColorName
cname forall a b. (a -> b) -> a -> b
$ \ (Color Pixel
black RGB
b) (Color Pixel
white RGB
w) (Color Pixel
gray RGB
g) ->
  if RGB
gforall a. Eq a => a -> a -> Bool
==RGB
b Bool -> Bool -> Bool
|| RGB
gforall a. Eq a => a -> a -> Bool
==RGB
w
  then Pixel -> Pixel -> K hi ho -> K hi ho
dithK Pixel
white Pixel
black K hi ho
cont
  else forall {i} {o}. [XCommand] -> K i o -> K i o
xcommandsK [[WindowAttributes] -> XCommand
ChangeWindowAttributes [Pixel -> WindowAttributes
CWBackPixel Pixel
gray],
                   XCommand
clearWindowExpose] forall a b. (a -> b) -> a -> b
$
       K hi ho
cont

greyBgK :: K hi ho -> K hi ho
greyBgK = forall {hi} {ho}.
ColorName
-> (Pixel -> Pixel -> K hi ho -> K hi ho) -> K hi ho -> K hi ho
trySolidGreyBgK ColorName
"grey" forall {hi} {ho}. Pixel -> Pixel -> K hi ho -> K hi ho
dithered50BgK
darkGreyBgK :: K hi ho -> K hi ho
darkGreyBgK = forall {hi} {ho}.
ColorName
-> (Pixel -> Pixel -> K hi ho -> K hi ho) -> K hi ho -> K hi ho
trySolidGreyBgK ColorName
"dark grey" forall {hi} {ho}. Pixel -> Pixel -> K hi ho -> K hi ho
dithered25BgK
lightGreyBgK :: K hi ho -> K hi ho
lightGreyBgK = forall {hi} {ho}.
ColorName
-> (Pixel -> Pixel -> K hi ho -> K hi ho) -> K hi ho -> K hi ho
trySolidGreyBgK ColorName
"light grey" forall {hi} {ho}. Pixel -> Pixel -> K hi ho -> K hi ho
dithered75BgK

changeBg :: ColorName -> (K a b) -> K a b
changeBg :: forall a b. ColorName -> K a b -> K a b
changeBg ColorName
bg =
  case ColorName
bg of
    ColorName
"Nothing" -> forall a. a -> a
id
    ColorName
"grey" -> forall {hi} {ho}. K hi ho -> K hi ho
greyBgK
    ColorName
_ -> forall {a} {i} {o}. (Show a, ColorGen a) => a -> K i o -> K i o
changeBackPixel ColorName
bg

alloc3 :: ColorName -> (Color -> Color -> Color -> f hi ho) -> f hi ho
alloc3 ColorName
colorname Color -> Color -> Color -> f hi ho
cont =
    forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
ColormapId -> ColorName -> Cont (f hi ho) Color
allocNamedColor ColormapId
defaultColormap ColorName
"black" forall a b. (a -> b) -> a -> b
$ \Color
black ->
    forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
ColormapId -> ColorName -> Cont (f hi ho) Color
allocNamedColor ColormapId
defaultColormap ColorName
"white" forall a b. (a -> b) -> a -> b
$ \Color
white ->
    forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
ColormapId -> ColorName -> (Maybe Color -> f hi ho) -> f hi ho
tryAllocNamedColor ColormapId
defaultColormap ColorName
colorname 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 hi ho
cont Color
black Color
white Color
color
    
try2 :: ColorName -> ColorName -> (Color -> f hi ho) -> f hi ho
try2 ColorName
cname1 ColorName
cname2 Color -> f hi ho
cont =
  forall c a. Cont c (Maybe a) -> c -> Cont c a
tryM (forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
ColormapId -> ColorName -> (Maybe Color -> f hi ho) -> f hi ho
tryAllocNamedColor ColormapId
defaultColormap ColorName
cname1)
       (forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
ColormapId -> ColorName -> Cont (f hi ho) Color
allocNamedColor ColormapId
defaultColormap ColorName
cname2 Color -> f hi ho
cont)
       Color -> f hi ho
cont