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 "forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
10 GCId
gc forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"<<FontStruct>>"forall a. [a] -> [a] -> [a]
++)

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

rootGCtx :: GCtx
rootGCtx = GCId -> FontData -> GCtx
GC GCId
rootGC (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
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 $
  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 forall a b. (a -> b) -> a -> b
$ \ [GCAttributes Pixel FontId]
gcattrs' FontData
fd' ->
  forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
Drawable
-> GCId
-> [GCAttributes Pixel FontId]
-> (GCId -> f hi ho)
-> f hi ho
createGC Drawable
drawable GCId
gc [GCAttributes Pixel FontId]
gcattrs' 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 = 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 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 = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. PixmapId -> Drawable
Pixmap forall a b. (a -> b) -> a -> b
$ PixmapId
x