module GCtx where
import GCAttrs
import Xtypes
import Gc(createGC)
import Command(Drawable(..))
--import Font(FontStruct)
--import FudgetIO
--import NullF(F,K)
--import Maptrace(ctrace)

data GCtx = GC GCId FontData
 --deriving (Show) -- don't want to see FontStruct
instance Show GCtx where
  showsPrec :: Int -> GCtx -> ShowS
showsPrec Int
d (GC GCId
gc FontData
fs) = (String
"GC "String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> GCId -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
10 GCId
gc ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"<<FontStruct>>"String -> ShowS
forall a. [a] -> [a] -> [a]
++)

gctx2gc :: GCtx -> GCId
gctx2gc (GC GCId
gc FontData
_) = GCId
gc

rootGCtx :: GCtx
rootGCtx = GCId -> FontData -> GCtx
GC GCId
rootGC (String -> FontData
forall a. HasCallStack => String -> a
error String
"GCtx.rootGCtx0")
--  if usefontstructs then rootGCtx2 else rootGCtx0

--rootGCtx0 = GC rootGC (FID (error "GCtx.rootGCtx0"))
--rootGCtx1 = ...
--rootGCtx2 = GC rootGC (FS (error "GCtx.rootGCtx2"))

data GCSpec -- move to module Drawing?
  = SoftGC [GCAttributes ColorSpec FontSpec]
  | HardGC GCtx
  deriving (Int -> GCSpec -> ShowS
[GCSpec] -> ShowS
GCSpec -> String
(Int -> GCSpec -> ShowS)
-> (GCSpec -> String) -> ([GCSpec] -> ShowS) -> Show GCSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GCSpec] -> ShowS
$cshowList :: [GCSpec] -> ShowS
show :: GCSpec -> String
$cshow :: GCSpec -> String
showsPrec :: Int -> GCSpec -> ShowS
$cshowsPrec :: Int -> GCSpec -> ShowS
Show)

createGCtx :: Drawable
-> GCtx -> [GCAttributes a1 a2] -> (GCtx -> f i o) -> f i o
createGCtx Drawable
drawable gctx :: GCtx
gctx@(GC GCId
gc FontData
fd) [GCAttributes a1 a2]
gcattrs GCtx -> f i o
k =
  --ctrace "gctrace" gc $
  FontData
-> [GCAttributes a1 a2]
-> ([GCAttributes Pixel FontId] -> FontData -> f i o)
-> f i o
forall a1 (f :: * -> * -> *) a2 i o.
(ColorGen a1, FudgetIO f, FontGen a2, Show a1, Show a2) =>
FontData
-> [GCAttributes a1 a2]
-> ([GCAttributes Pixel FontId] -> FontData -> f i o)
-> f i o
convGCSpecK FontData
fd [GCAttributes a1 a2]
gcattrs (([GCAttributes Pixel FontId] -> FontData -> f i o) -> f i o)
-> ([GCAttributes Pixel FontId] -> FontData -> f i o) -> f i o
forall a b. (a -> b) -> a -> b
$ \ [GCAttributes Pixel FontId]
gcattrs' FontData
fd' ->
  Drawable
-> GCId -> [GCAttributes Pixel FontId] -> (GCId -> f i o) -> f i o
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
Drawable
-> GCId
-> [GCAttributes Pixel FontId]
-> (GCId -> f b ho)
-> f b ho
createGC Drawable
drawable GCId
gc [GCAttributes Pixel FontId]
gcattrs' ((GCId -> f i o) -> f i o) -> (GCId -> f i o) -> f i o
forall a b. (a -> b) -> a -> b
$ \ GCId
gc' ->
  --ctrace "gctrace" gc' $
  GCtx -> f i o
k (GCId -> FontData -> GCtx
GC GCId
gc' FontData
fd')

wCreateGCtx :: GCtx -> [GCAttributes a1 a2] -> (GCtx -> f i o) -> f i o
wCreateGCtx GCtx
x = Drawable
-> GCtx -> [GCAttributes a1 a2] -> (GCtx -> f i o) -> f i o
forall a1 (f :: * -> * -> *) a2 i o.
(ColorGen a1, FudgetIO f, FontGen a2, Show a1, Show a2) =>
Drawable
-> GCtx -> [GCAttributes a1 a2] -> (GCtx -> f i o) -> f i o
createGCtx Drawable
MyWindow (GCtx -> [GCAttributes a1 a2] -> (GCtx -> f i o) -> f i o)
-> GCtx -> [GCAttributes a1 a2] -> (GCtx -> f i o) -> f i o
forall a b. (a -> b) -> a -> b
$ GCtx
x
pmCreateGCtx :: PixmapId
-> GCtx -> [GCAttributes a1 a2] -> (GCtx -> f i o) -> f i o
pmCreateGCtx PixmapId
x = Drawable
-> GCtx -> [GCAttributes a1 a2] -> (GCtx -> f i o) -> f i o
forall a1 (f :: * -> * -> *) a2 i o.
(ColorGen a1, FudgetIO f, FontGen a2, Show a1, Show a2) =>
Drawable
-> GCtx -> [GCAttributes a1 a2] -> (GCtx -> f i o) -> f i o
createGCtx (Drawable
 -> GCtx -> [GCAttributes a1 a2] -> (GCtx -> f i o) -> f i o)
-> (PixmapId -> Drawable)
-> PixmapId
-> GCtx
-> [GCAttributes a1 a2]
-> (GCtx -> f i o)
-> f i o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PixmapId -> Drawable
Pixmap (PixmapId
 -> GCtx -> [GCAttributes a1 a2] -> (GCtx -> f i o) -> f i o)
-> PixmapId
-> GCtx
-> [GCAttributes a1 a2]
-> (GCtx -> f i o)
-> f i o
forall a b. (a -> b) -> a -> b
$ PixmapId
x