{-# LANGUAGE CPP #-}
module GCAttrs(module GCAttrs,Cont(..)) where
import FudgetIO
import Xtypes
import EitherUtils(Cont(..))
import Font(FontStruct,font_id,font_range, font_prop, update_font_id)
import Color(tryAllocNamedColor,tryAllocColor)
import LoadFont(listFontsWithInfo,loadFont,loadQueryFont)
import FontProperty(fontProperty)
import CmdLineEnv(argKey)
import Utils(aboth,segments)
#include "exists.h"
data FontData
= FID FontStruct
| FS FontStruct
fdFontId :: FontData -> FontId
fdFontId (FID FontStruct
fs) = FontStruct -> FontId
forall per_char. FontStructF per_char -> FontId
font_id FontStruct
fs
fdFontId (FS FontStruct
fs) = FontStruct -> FontId
forall per_char. FontStructF per_char -> FontId
font_id FontStruct
fs
fontdata2struct :: FontData -> (FontStruct -> p) -> p
fontdata2struct (FS FontStruct
fs) FontStruct -> p
k = FontStruct -> p
k FontStruct
fs
fontdata2struct (FID FontStruct
fs) FontStruct -> p
k = FontStruct -> p
k FontStruct
fs
#ifdef USE_EXIST_Q
data ColorSpec = EXISTS(a) TSTHACK((Show EQV(a),ColorGen EQV(a)) =>) ColorSpec EQV(a)
instance Show ColorSpec where showsPrec :: Int -> ColorSpec -> ShowS
showsPrec Int
n (ColorSpec a
c) = Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
n a
c
data FontSpec = EXISTS(a) TSTHACK((Show EQV(a),FontGen EQV(a)) =>) FontSpeci EQV(a)
instance Show FontSpec where showsPrec :: Int -> FontSpec -> ShowS
showsPrec Int
n (FontSpeci a
f) = Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
n a
f
colorSpec :: a -> ColorSpec
colorSpec a
x = a -> ColorSpec
forall a. (Show a, ColorGen a) => a -> ColorSpec
ColorSpec a
x
fontSpec :: a -> FontSpec
fontSpec a
x = a -> FontSpec
forall a. (Show a, FontGen a) => a -> FontSpec
FontSpeci a
x
#else
data ColorSpec = StringCS ColorName | RGBCS RGB | PixelCS Pixel | ListCS [ColorSpec] deriving (Show)
data FontSpec = StringFS FontName | FontIdFS FontId | FontStructFS FontStruct | ListFS [FontSpec] deriving (Show)
#endif
class ColorGen a where
IFNOEXIST(colorSpec :: a -> ColorSpec)
tryConvColorK :: FudgetIO f => a -> Cont (f i o) (Maybe Pixel)
IFNOEXIST(colorSpecList :: [a] -> ColorSpec)
convColorListK :: FudgetIO f => [a] -> Cont (f i o) (Maybe Pixel)
convColorListK = (a -> Cont (f i o) (Maybe Pixel))
-> [a] -> Cont (f i o) (Maybe Pixel)
forall t a b.
(t -> (Maybe a -> b) -> b) -> [t] -> (Maybe a -> b) -> b
convList a -> Cont (f i o) (Maybe Pixel)
forall a (f :: * -> * -> *) i o.
(ColorGen a, FudgetIO f) =>
a -> Cont (f i o) (Maybe Pixel)
tryConvColorK
IFNOEXIST(colorSpecList = ListCS . map colorSpec)
convColorK :: a -> (Pixel -> f i o) -> f i o
convColorK a
c = a -> Cont (f i o) (Maybe Pixel)
forall a (f :: * -> * -> *) i o.
(ColorGen a, FudgetIO f) =>
a -> Cont (f i o) (Maybe Pixel)
tryConvColorK a
c Cont (f i o) (Maybe Pixel)
-> ((Pixel -> f i o) -> Maybe Pixel -> f i o)
-> (Pixel -> f i o)
-> f i o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f i o -> (Pixel -> f i o) -> Maybe Pixel -> f i o
forall b a. b -> (a -> b) -> Maybe a -> b
maybe f i o
forall a. a
err
where err :: a
err = String -> a
forall a. HasCallStack => String -> a
error (String
"Can't allocate color: "String -> ShowS
forall a. [a] -> [a] -> [a]
++a -> String
forall a. Show a => a -> String
show a
c)
class FontGen a where
IFNOEXIST(fontSpec :: a -> FontSpec)
tryConvFontK :: FudgetIO f => a -> Cont (f i o) (Maybe FontData)
IFNOEXIST(fontSpecList :: [a] -> FontSpec)
convFontListK :: FudgetIO f => [a] -> Cont (f i o) (Maybe FontData)
IFNOEXIST(fontSpecList = ListFS . map fontSpec)
convFontListK = (a -> Cont (f i o) (Maybe FontData))
-> [a] -> Cont (f i o) (Maybe FontData)
forall t a b.
(t -> (Maybe a -> b) -> b) -> [t] -> (Maybe a -> b) -> b
convList a -> Cont (f i o) (Maybe FontData)
forall a (f :: * -> * -> *) i o.
(FontGen a, FudgetIO f) =>
a -> Cont (f i o) (Maybe FontData)
tryConvFontK
convFontK :: a -> (FontData -> f i o) -> f i o
convFontK a
f FontData -> f i o
k = a -> Cont (f i o) (Maybe FontData)
forall a (f :: * -> * -> *) i o.
(FontGen a, FudgetIO f) =>
a -> Cont (f i o) (Maybe FontData)
tryConvFontK a
f Cont (f i o) (Maybe FontData) -> Cont (f i o) (Maybe FontData)
forall a b. (a -> b) -> a -> b
$ f i o -> (FontData -> f i o) -> Maybe FontData -> f i o
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Cont (f i o) (Maybe FontData)
forall a (f :: * -> * -> *) i o.
(FontGen a, FudgetIO f) =>
a -> Cont (f i o) (Maybe FontData)
tryConvFontK String
"fixed" Cont (f i o) (Maybe FontData) -> Cont (f i o) (Maybe FontData)
forall a b. (a -> b) -> a -> b
$ f i o -> (FontData -> f i o) -> Maybe FontData -> f i o
forall b a. b -> (a -> b) -> Maybe a -> b
maybe f i o
forall a. a
err FontData -> f i o
k) FontData -> f i o
k
where err :: a
err = String -> a
forall a. HasCallStack => String -> a
error (String
"Can't load font: "String -> ShowS
forall a. [a] -> [a] -> [a]
++a -> String
forall a. Show a => a -> String
show a
f)
convList :: (t -> (Maybe a -> b) -> b) -> [t] -> (Maybe a -> b) -> b
convList t -> (Maybe a -> b) -> b
try [t]
xs Maybe a -> b
cont = [t] -> b
conv [t]
xs
where conv :: [t] -> b
conv [] = Maybe a -> b
cont Maybe a
forall a. Maybe a
Nothing
conv (t
x:[t]
xs) = t -> (Maybe a -> b) -> b
try t
x ((Maybe a -> b) -> b) -> (Maybe a -> b) -> b
forall a b. (a -> b) -> a -> b
$ b -> (a -> b) -> Maybe a -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([t] -> b
conv [t]
xs) (Maybe a -> b
cont (Maybe a -> b) -> (a -> Maybe a) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just)
#ifdef USE_EXIST_Q
instance ColorGen ColorSpec where tryConvColorK :: ColorSpec -> Cont (f i o) (Maybe Pixel)
tryConvColorK (ColorSpec a
c) = a -> Cont (f i o) (Maybe Pixel)
forall a (f :: * -> * -> *) i o.
(ColorGen a, FudgetIO f) =>
a -> Cont (f i o) (Maybe Pixel)
tryConvColorK a
c
instance FontGen FontSpec where tryConvFontK :: FontSpec -> Cont (f i o) (Maybe FontData)
tryConvFontK (FontSpeci a
c) = a -> Cont (f i o) (Maybe FontData)
forall a (f :: * -> * -> *) i o.
(FontGen a, FudgetIO f) =>
a -> Cont (f i o) (Maybe FontData)
tryConvFontK a
c
#else
instance ColorGen ColorSpec where
colorSpec = id
tryConvColorK cs =
case cs of
StringCS s -> tryConvColorK s
PixelCS pixel -> tryConvColorK pixel
RGBCS rgb -> tryConvColorK rgb
ListCS cs -> tryConvColorK cs
instance FontGen FontSpec where
fontSpec = id
tryConvFontK fs =
case fs of
StringFS name -> tryConvFontK name
FontStructFS fstr -> tryConvFontK fstr
ListFS fs -> tryConvFontK fs
#endif
instance ColorGen c => ColorGen [c] where
IFNOEXIST(colorSpec = colorSpecList)
tryConvColorK :: [c] -> Cont (f i o) (Maybe Pixel)
tryConvColorK = [c] -> Cont (f i o) (Maybe Pixel)
forall c (f :: * -> * -> *) i o.
(ColorGen c, FudgetIO f) =>
[c] -> Cont (f i o) (Maybe Pixel)
convColorListK
instance FontGen a => FontGen [a] where
IFNOEXIST(fontSpec = fontSpecList)
tryConvFontK :: [a] -> Cont (f i o) (Maybe FontData)
tryConvFontK = [a] -> Cont (f i o) (Maybe FontData)
forall a (f :: * -> * -> *) i o.
(FontGen a, FudgetIO f) =>
[a] -> Cont (f i o) (Maybe FontData)
convFontListK
instance ColorGen Char where
IFNOEXIST(colorSpec c = StringCS [c])
IFNOEXIST(colorSpecList s = StringCS s)
tryConvColorK :: Char -> Cont (f i o) (Maybe Pixel)
tryConvColorK Char
c = String -> Cont (f i o) (Maybe Pixel)
forall c (f :: * -> * -> *) i o.
(ColorGen c, FudgetIO f) =>
[c] -> Cont (f i o) (Maybe Pixel)
convColorListK [Char
c]
convColorListK :: String -> Cont (f i o) (Maybe Pixel)
convColorListK String
s Maybe Pixel -> f i o
k = ColormapId -> String -> (Maybe Color -> f i o) -> f i o
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
ColormapId -> String -> (Maybe Color -> f b ho) -> f b ho
tryAllocNamedColor ColormapId
defaultColormap String
s (Maybe Pixel -> f i o
k (Maybe Pixel -> f i o)
-> (Maybe Color -> Maybe Pixel) -> Maybe Color -> f i o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Color -> Pixel) -> Maybe Color -> Maybe Pixel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Color -> Pixel
colorPixel)
getFontData :: FudgetIO f => [Char] -> Cont (f i o) (Maybe FontData)
getFontData :: String -> Cont (f i o) (Maybe FontData)
getFontData =
case String
usefontstructs of
String
"yes" -> String -> Cont (f i o) (Maybe FontData)
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
String -> (Maybe FontData -> f b ho) -> f b ho
qf
String
"no" -> String -> Cont (f i o) (Maybe FontData)
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
String -> (Maybe FontData -> f b ho) -> f b ho
lf
String
_ -> String -> Cont (f i o) (Maybe FontData)
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
String -> (Maybe FontData -> f b ho) -> f b ho
autof
where
qf :: String -> (Maybe FontData -> f b ho) -> f b ho
qf String
fname Maybe FontData -> f b ho
k = String -> (Maybe FontStruct -> f b ho) -> f b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
String -> (Maybe FontStruct -> f b ho) -> f b ho
loadQueryFont String
fname (Maybe FontData -> f b ho
k (Maybe FontData -> f b ho)
-> (Maybe FontStruct -> Maybe FontData)
-> Maybe FontStruct
-> f b ho
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FontStruct -> FontData) -> Maybe FontStruct -> Maybe FontData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FontStruct -> FontData
FS)
lf :: String -> (Maybe FontData -> f b ho) -> f b ho
lf String
fname Maybe FontData -> f b ho
k =
String -> Int -> ([(String, FontStruct)] -> f b ho) -> f b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
String -> Int -> ([(String, FontStruct)] -> f b ho) -> f b ho
listFontsWithInfo String
fname Int
1 (([(String, FontStruct)] -> f b ho) -> f b ho)
-> ([(String, FontStruct)] -> f b ho) -> f b ho
forall a b. (a -> b) -> a -> b
$ \ [(String, FontStruct)]
fis ->
case [(String, FontStruct)]
fis of
[] -> Maybe FontData -> f b ho
k Maybe FontData
forall a. Maybe a
Nothing
(String
fn,FontStruct
fs):[(String, FontStruct)]
_ -> String -> (FontId -> f b ho) -> f b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
String -> (FontId -> f b ho) -> f b ho
loadFont String
fname ((FontId -> f b ho) -> f b ho) -> (FontId -> f b ho) -> f b ho
forall a b. (a -> b) -> a -> b
$ \FontId
fid -> Maybe FontData -> f b ho
k (Maybe FontData -> f b ho) -> Maybe FontData -> f b ho
forall a b. (a -> b) -> a -> b
$ FontData -> Maybe FontData
forall a. a -> Maybe a
Just (FontData -> Maybe FontData) -> FontData -> Maybe FontData
forall a b. (a -> b) -> a -> b
$ FontStruct -> FontData
FID (FontStruct -> FontData) -> FontStruct -> FontData
forall a b. (a -> b) -> a -> b
$ FontStruct -> FontId -> FontStruct
forall per_char.
FontStructF per_char -> FontId -> FontStructF per_char
update_font_id FontStruct
fs FontId
fid
autof :: String -> (Maybe FontData -> f b ho) -> f b ho
autof String
fname Maybe FontData -> f b ho
k =
String -> Int -> ([(String, FontStruct)] -> f b ho) -> f b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
String -> Int -> ([(String, FontStruct)] -> f b ho) -> f b ho
listFontsWithInfo String
fname Int
1 (([(String, FontStruct)] -> f b ho) -> f b ho)
-> ([(String, FontStruct)] -> f b ho) -> f b ho
forall a b. (a -> b) -> a -> b
$ \ [(String, FontStruct)]
fis ->
case [(String, FontStruct)]
fis of
[] -> Maybe FontData -> f b ho
k Maybe FontData
forall a. Maybe a
Nothing
(String
fn,FontStruct
fs):[(String, FontStruct)]
_ -> let fprops :: [FontProp]
fprops = FontStruct -> [FontProp]
forall per_char. FontStructF per_char -> [FontProp]
font_prop FontStruct
fs
in [FontProp] -> String -> (Maybe String -> f b ho) -> f b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
[FontProp] -> String -> (Maybe String -> f b ho) -> f b ho
fontProperty [FontProp]
fprops String
"SPACING" ((Maybe String -> f b ho) -> f b ho)
-> (Maybe String -> f b ho) -> f b ho
forall a b. (a -> b) -> a -> b
$ \Maybe String
spacing ->
[FontProp] -> String -> (Maybe String -> f b ho) -> f b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
[FontProp] -> String -> (Maybe String -> f b ho) -> f b ho
fontProperty [FontProp]
fprops String
"FONT" ((Maybe String -> f b ho) -> f b ho)
-> (Maybe String -> f b ho) -> f b ho
forall a b. (a -> b) -> a -> b
$ \Maybe String
font ->
if Int
char_countInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
256
then String -> (Maybe FontData -> f b ho) -> f b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
String -> (Maybe FontData -> f b ho) -> f b ho
qf String
fn Maybe FontData -> f b ho
k
else let fscons :: FontStruct -> FontData
fscons = if (Maybe String -> Maybe String -> Bool
fixed_width Maybe String
font Maybe String
spacing)
then FontStruct -> FontData
FS
else FontStruct -> FontData
FID
in String -> (FontId -> f b ho) -> f b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
String -> (FontId -> f b ho) -> f b ho
loadFont String
fname ((FontId -> f b ho) -> f b ho) -> (FontId -> f b ho) -> f b ho
forall a b. (a -> b) -> a -> b
$ \FontId
fid ->
Maybe FontData -> f b ho
k (Maybe FontData -> f b ho) -> Maybe FontData -> f b ho
forall a b. (a -> b) -> a -> b
$ FontData -> Maybe FontData
forall a. a -> Maybe a
Just (FontData -> Maybe FontData) -> FontData -> Maybe FontData
forall a b. (a -> b) -> a -> b
$ FontStruct -> FontData
fscons (FontStruct -> FontData) -> FontStruct -> FontData
forall a b. (a -> b) -> a -> b
$ FontStruct -> FontId -> FontStruct
forall per_char.
FontStructF per_char -> FontId -> FontStructF per_char
update_font_id FontStruct
fs FontId
fid
where
char_count :: Int
char_count = Int
hiInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
lo
(Int
lo,Int
hi) = (Char -> Int) -> (Char, Char) -> (Int, Int)
forall t b. (t -> b) -> (t, t) -> (b, b)
aboth Char -> Int
forall a. Enum a => a -> Int
fromEnum (FontStruct -> (Char, Char)
forall per_char. FontStructF per_char -> (Char, Char)
font_range FontStruct
fs)
fixed_width :: Maybe String -> Maybe String -> Bool
fixed_width Maybe String
fnt Maybe String
spcng =
let spc :: [String]
spc = (Char -> Bool) -> String -> [String]
forall a. (a -> Bool) -> [a] -> [[a]]
segments (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'-') String
fn
spct :: [String]
spct = (Char -> Bool) -> String -> [String]
forall a. (a -> Bool) -> [a] -> [[a]]
segments (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-') String
fnt'
monosp :: [String]
monosp = [String
"m", String
"c", String
"M", String
"C"]
[String
fnt', String
spcng'] = (Maybe String -> String) -> [Maybe String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\Maybe String
s -> case Maybe String
s of
Just String
c -> String
c
Maybe String
_ -> String
"\xFF") [Maybe String
fnt, Maybe String
spcng]
lspc :: Int
lspc = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
spc
lspct :: Int
lspct = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
spct
in String
spcng' String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
monosp Bool -> Bool -> Bool
||
Int
lspct Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
11 Bool -> Bool -> Bool
&& ([String]
spct [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
11) String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
monosp Bool -> Bool -> Bool
||
Int
lspc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
11 Bool -> Bool -> Bool
&& ([String]
spc [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
11) String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
monosp Bool -> Bool -> Bool
||
Int
lspc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& ([String] -> String
forall a. [a] -> a
head [String]
spc) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"fixed"
instance FontGen Char where
IFNOEXIST(fontSpec c = StringFS [c])
IFNOEXIST(fontSpecList s = StringFS s)
tryConvFontK :: Char -> Cont (f i o) (Maybe FontData)
tryConvFontK Char
f = String -> Cont (f i o) (Maybe FontData)
forall a (f :: * -> * -> *) i o.
(FontGen a, FudgetIO f) =>
[a] -> Cont (f i o) (Maybe FontData)
convFontListK [Char
f]
convFontListK :: String -> Cont (f i o) (Maybe FontData)
convFontListK = String -> Cont (f i o) (Maybe FontData)
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
String -> (Maybe FontData -> f b ho) -> f b ho
getFontData
tryConvColorRGBK :: RGB -> (Maybe Pixel -> f b ho) -> f b ho
tryConvColorRGBK RGB
rgb Maybe Pixel -> f b ho
k = ColormapId -> RGB -> (Maybe Color -> f b ho) -> f b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
ColormapId -> RGB -> (Maybe Color -> f b ho) -> f b ho
tryAllocColor ColormapId
defaultColormap RGB
rgb (Maybe Pixel -> f b ho
k (Maybe Pixel -> f b ho)
-> (Maybe Color -> Maybe Pixel) -> Maybe Color -> f b ho
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Color -> Pixel) -> Maybe Color -> Maybe Pixel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Color -> Pixel
colorPixel)
instance ColorGen RGB where
IFNOEXIST(colorSpec = RGBCS)
tryConvColorK :: RGB -> Cont (f i o) (Maybe Pixel)
tryConvColorK = RGB -> Cont (f i o) (Maybe Pixel)
forall (f :: * -> * -> *) i o.
FudgetIO f =>
RGB -> Cont (f i o) (Maybe Pixel)
tryConvColorRGBK
instance ColorGen Pixel where
IFNOEXIST(colorSpec = PixelCS)
tryConvColorK :: Pixel -> Cont (f i o) (Maybe Pixel)
tryConvColorK Pixel
p Maybe Pixel -> f i o
k = Maybe Pixel -> f i o
k (Pixel -> Maybe Pixel
forall a. a -> Maybe a
Just Pixel
p)
instance FontGen FontStruct where
IFNOEXIST(fontSpec = FontStructFS)
tryConvFontK :: FontStruct -> Cont (f i o) (Maybe FontData)
tryConvFontK FontStruct
fs Maybe FontData -> f i o
k = Maybe FontData -> f i o
k (FontData -> Maybe FontData
forall a. a -> Maybe a
Just (FontStruct -> FontData
FS FontStruct
fs))
convGCSpecK :: FontData
-> [GCAttributes a a]
-> ([GCAttributes Pixel FontId] -> FontData -> f i o)
-> f i o
convGCSpecK FontData
fs [GCAttributes a a]
attrs = FontData
-> [GCAttributes a a]
-> [GCAttributes Pixel FontId]
-> ([GCAttributes Pixel FontId] -> FontData -> f i o)
-> f i o
forall a (f :: * -> * -> *) a i o.
(ColorGen a, FudgetIO f, FontGen a, Show a, Show a) =>
FontData
-> [GCAttributes a a]
-> [GCAttributes Pixel FontId]
-> ([GCAttributes Pixel FontId] -> FontData -> f i o)
-> f i o
gcattrsK FontData
fs [GCAttributes a a]
attrs []
where
gcattrsK :: FontData
-> [GCAttributes a a]
-> [GCAttributes Pixel FontId]
-> ([GCAttributes Pixel FontId] -> FontData -> f i o)
-> f i o
gcattrsK FontData
fs [] [GCAttributes Pixel FontId]
outattrs [GCAttributes Pixel FontId] -> FontData -> f i o
dr = [GCAttributes Pixel FontId] -> FontData -> f i o
dr ([GCAttributes Pixel FontId] -> [GCAttributes Pixel FontId]
forall a. [a] -> [a]
reverse [GCAttributes Pixel FontId]
outattrs) FontData
fs
gcattrsK FontData
fs (GCAttributes a a
attr : [GCAttributes a a]
attrs) [GCAttributes Pixel FontId]
outattrs [GCAttributes Pixel FontId] -> FontData -> f i o
dr =
let cp :: GCAttributes Pixel FontId -> f i o
cp GCAttributes Pixel FontId
attr' = FontData
-> [GCAttributes a a]
-> [GCAttributes Pixel FontId]
-> ([GCAttributes Pixel FontId] -> FontData -> f i o)
-> f i o
gcattrsK FontData
fs [GCAttributes a a]
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] -> FontData -> f i o
dr
in case GCAttributes a a
attr of
GCForeground a
colspec ->
a -> (Pixel -> f i o) -> f i o
forall a (f :: * -> * -> *) i o.
(ColorGen a, FudgetIO f, Show a) =>
a -> (Pixel -> f i o) -> f i o
convColorK a
colspec ((Pixel -> f i o) -> f i o) -> (Pixel -> f i o) -> f i o
forall a b. (a -> b) -> a -> b
$ \Pixel
fg ->
FontData
-> [GCAttributes a a]
-> [GCAttributes Pixel FontId]
-> ([GCAttributes Pixel FontId] -> FontData -> f i o)
-> f i o
gcattrsK FontData
fs [GCAttributes a a]
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] -> FontData -> f i o
dr
GCBackground a
colspec ->
a -> (Pixel -> f i o) -> f i o
forall a (f :: * -> * -> *) i o.
(ColorGen a, FudgetIO f, Show a) =>
a -> (Pixel -> f i o) -> f i o
convColorK a
colspec ((Pixel -> f i o) -> f i o) -> (Pixel -> f i o) -> f i o
forall a b. (a -> b) -> a -> b
$ \Pixel
fg ->
FontData
-> [GCAttributes a a]
-> [GCAttributes Pixel FontId]
-> ([GCAttributes Pixel FontId] -> FontData -> f i o)
-> f i o
gcattrsK FontData
fs [GCAttributes a a]
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] -> FontData -> f i o
dr
GCFont a
fspec ->
a -> (FontData -> f i o) -> f i o
forall a (f :: * -> * -> *) i o.
(FontGen a, FudgetIO f, Show a) =>
a -> (FontData -> f i o) -> f i o
convFontK a
fspec ((FontData -> f i o) -> f i o) -> (FontData -> f i o) -> f i o
forall a b. (a -> b) -> a -> b
$ \FontData
fs' ->
FontData
-> [GCAttributes a a]
-> [GCAttributes Pixel FontId]
-> ([GCAttributes Pixel FontId] -> FontData -> f i o)
-> f i o
gcattrsK FontData
fs' [GCAttributes a a]
attrs (FontId -> GCAttributes Pixel FontId
forall a b. b -> GCAttributes a b
GCFont (FontData -> FontId
fdFontId FontData
fs') GCAttributes Pixel FontId
-> [GCAttributes Pixel FontId] -> [GCAttributes Pixel FontId]
forall a. a -> [a] -> [a]
: [GCAttributes Pixel FontId]
outattrs) [GCAttributes Pixel FontId] -> FontData -> f i o
dr
GCFunction GCFunction
f -> GCAttributes Pixel FontId -> f i o
cp (GCFunction -> GCAttributes Pixel FontId
forall a b. GCFunction -> GCAttributes a b
GCFunction GCFunction
f)
GCLineWidth Int
w -> GCAttributes Pixel FontId -> f i o
cp (Int -> GCAttributes Pixel FontId
forall a b. Int -> GCAttributes a b
GCLineWidth Int
w)
GCLineStyle GCLineStyle
s -> GCAttributes Pixel FontId -> f i o
cp (GCLineStyle -> GCAttributes Pixel FontId
forall a b. GCLineStyle -> GCAttributes a b
GCLineStyle GCLineStyle
s)
GCCapStyle GCCapStyle
s -> GCAttributes Pixel FontId -> f i o
cp (GCCapStyle -> GCAttributes Pixel FontId
forall a b. GCCapStyle -> GCAttributes a b
GCCapStyle GCCapStyle
s)
GCJoinStyle GCJoinStyle
s -> GCAttributes Pixel FontId -> f i o
cp (GCJoinStyle -> GCAttributes Pixel FontId
forall a b. GCJoinStyle -> GCAttributes a b
GCJoinStyle GCJoinStyle
s)
GCSubwindowMode GCSubwindowMode
m -> GCAttributes Pixel FontId -> f i o
cp (GCSubwindowMode -> GCAttributes Pixel FontId
forall a b. GCSubwindowMode -> GCAttributes a b
GCSubwindowMode GCSubwindowMode
m)
GCGraphicsExposures Bool
b -> GCAttributes Pixel FontId -> f i o
cp (Bool -> GCAttributes Pixel FontId
forall a b. Bool -> GCAttributes a b
GCGraphicsExposures Bool
b)
gcFgA,gcBgA :: c -> [GCAttributes c FontSpec]
gcBgA :: c -> [GCAttributes c FontSpec]
gcBgA c
c = [c -> GCAttributes c FontSpec
forall a b. a -> GCAttributes a b
GCBackground c
c]
gcFgA :: c -> [GCAttributes c FontSpec]
gcFgA c
c = [c -> GCAttributes c FontSpec
forall a b. a -> GCAttributes a b
GCForeground c
c]
gcFontA :: f -> [GCAttributes ColorSpec f]
gcFontA :: f -> [GCAttributes ColorSpec f]
gcFontA f
f = [f -> GCAttributes ColorSpec f
forall a b. b -> GCAttributes a b
GCFont f
f]
usefontstructs :: String
usefontstructs = String -> ShowS
argKey String
"fontstructs" String
"auto"