module Convgc(convGCattrsK) where
import Color
--import Font(FontStruct)
--import Fudget
import LoadFont
--import Spops
import Xtypes
import EitherUtils() -- synonym Cont, for hbc

convGCattrsK :: [GCAttributes ColorName ColorName]
-> ([GCAttributes Pixel FontId] -> f b ho) -> f b ho
convGCattrsK [GCAttributes ColorName ColorName]
attrs = [GCAttributes ColorName ColorName]
-> [GCAttributes Pixel FontId]
-> ([GCAttributes Pixel FontId] -> f b ho)
-> f b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
[GCAttributes ColorName ColorName]
-> [GCAttributes Pixel FontId]
-> ([GCAttributes Pixel FontId] -> f b ho)
-> f b ho
gcattrsK [GCAttributes ColorName ColorName]
attrs []

gcattrsK :: [GCAttributes ColorName ColorName]
-> [GCAttributes Pixel FontId]
-> ([GCAttributes Pixel FontId] -> f b ho)
-> f b ho
gcattrsK [] [GCAttributes Pixel FontId]
outattrs [GCAttributes Pixel FontId] -> f b ho
dr = [GCAttributes Pixel FontId] -> f b ho
dr ([GCAttributes Pixel FontId] -> [GCAttributes Pixel FontId]
forall a. [a] -> [a]
reverse [GCAttributes Pixel FontId]
outattrs)
gcattrsK (GCAttributes ColorName ColorName
attr : [GCAttributes ColorName ColorName]
attrs) [GCAttributes Pixel FontId]
outattrs [GCAttributes Pixel FontId] -> f b ho
dr =
  let cp :: GCAttributes Pixel FontId -> f b ho
cp GCAttributes Pixel FontId
attr' = [GCAttributes ColorName ColorName]
-> [GCAttributes Pixel FontId]
-> ([GCAttributes Pixel FontId] -> f b ho)
-> f b ho
gcattrsK [GCAttributes ColorName ColorName]
attrs (GCAttributes Pixel FontId
attr' GCAttributes Pixel FontId
-> [GCAttributes Pixel FontId] -> [GCAttributes Pixel FontId]
forall a. a -> [a] -> [a]
: [GCAttributes Pixel FontId]
outattrs) [GCAttributes Pixel FontId] -> f b ho
dr
  in case GCAttributes ColorName ColorName
attr of
       GCForeground ColorName
colname ->
         ColormapId -> ColorName -> Cont (f b ho) Pixel
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
ColormapId -> ColorName -> Cont (f b ho) Pixel
allocNamedColorPixel ColormapId
defaultColormap ColorName
colname Cont (f b ho) Pixel -> Cont (f b ho) Pixel
forall a b. (a -> b) -> a -> b
$ \Pixel
fg ->
	 [GCAttributes ColorName ColorName]
-> [GCAttributes Pixel FontId]
-> ([GCAttributes Pixel FontId] -> f b ho)
-> f b ho
gcattrsK [GCAttributes ColorName ColorName]
attrs (Pixel -> GCAttributes Pixel FontId
forall a b. a -> GCAttributes a b
GCForeground Pixel
fg GCAttributes Pixel FontId
-> [GCAttributes Pixel FontId] -> [GCAttributes Pixel FontId]
forall a. a -> [a] -> [a]
: [GCAttributes Pixel FontId]
outattrs) [GCAttributes Pixel FontId] -> f b ho
dr
       GCBackground ColorName
colname ->
         ColormapId -> ColorName -> Cont (f b ho) Pixel
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
ColormapId -> ColorName -> Cont (f b ho) Pixel
allocNamedColorPixel ColormapId
defaultColormap ColorName
colname Cont (f b ho) Pixel -> Cont (f b ho) Pixel
forall a b. (a -> b) -> a -> b
$ \Pixel
fg ->
	 [GCAttributes ColorName ColorName]
-> [GCAttributes Pixel FontId]
-> ([GCAttributes Pixel FontId] -> f b ho)
-> f b ho
gcattrsK [GCAttributes ColorName ColorName]
attrs (Pixel -> GCAttributes Pixel FontId
forall a b. a -> GCAttributes a b
GCBackground Pixel
fg GCAttributes Pixel FontId
-> [GCAttributes Pixel FontId] -> [GCAttributes Pixel FontId]
forall a. a -> [a] -> [a]
: [GCAttributes Pixel FontId]
outattrs) [GCAttributes Pixel FontId] -> f b ho
dr
       GCFont ColorName
fname ->
         ColorName -> (FontId -> f b ho) -> f b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
ColorName -> (FontId -> f b ho) -> f b ho
loadFont ColorName
fname ((FontId -> f b ho) -> f b ho) -> (FontId -> f b ho) -> f b ho
forall a b. (a -> b) -> a -> b
$ \FontId
font ->
	 [GCAttributes ColorName ColorName]
-> [GCAttributes Pixel FontId]
-> ([GCAttributes Pixel FontId] -> f b ho)
-> f b ho
gcattrsK [GCAttributes ColorName ColorName]
attrs (FontId -> GCAttributes Pixel FontId
forall a b. b -> GCAttributes a b
GCFont FontId
font GCAttributes Pixel FontId
-> [GCAttributes Pixel FontId] -> [GCAttributes Pixel FontId]
forall a. a -> [a] -> [a]
: [GCAttributes Pixel FontId]
outattrs) [GCAttributes Pixel FontId] -> f b ho
dr
       GCFunction GCFunction
f -> GCAttributes Pixel FontId -> f b ho
cp (GCFunction -> GCAttributes Pixel FontId
forall a b. GCFunction -> GCAttributes a b
GCFunction GCFunction
f)
       GCLineWidth Width
w -> GCAttributes Pixel FontId -> f b ho
cp (Width -> GCAttributes Pixel FontId
forall a b. Width -> GCAttributes a b
GCLineWidth Width
w)
       GCLineStyle GCLineStyle
s -> GCAttributes Pixel FontId -> f b ho
cp (GCLineStyle -> GCAttributes Pixel FontId
forall a b. GCLineStyle -> GCAttributes a b
GCLineStyle GCLineStyle
s)
       GCCapStyle GCCapStyle
s -> GCAttributes Pixel FontId -> f b ho
cp (GCCapStyle -> GCAttributes Pixel FontId
forall a b. GCCapStyle -> GCAttributes a b
GCCapStyle GCCapStyle
s)
       GCJoinStyle GCJoinStyle
s -> GCAttributes Pixel FontId -> f b ho
cp (GCJoinStyle -> GCAttributes Pixel FontId
forall a b. GCJoinStyle -> GCAttributes a b
GCJoinStyle GCJoinStyle
s)
       GCSubwindowMode GCSubwindowMode
m -> GCAttributes Pixel FontId -> f b ho
cp (GCSubwindowMode -> GCAttributes Pixel FontId
forall a b. GCSubwindowMode -> GCAttributes a b
GCSubwindowMode GCSubwindowMode
m)
       GCGraphicsExposures Bool
b -> GCAttributes Pixel FontId -> f b ho
cp (Bool -> GCAttributes Pixel FontId
forall a b. Bool -> GCAttributes a b
GCGraphicsExposures Bool
b)