Convgc.hs

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

convGCattrsK attrs = gcattrsK attrs []

gcattrsK [] outattrs dr = dr (reverse outattrs)
gcattrsK (attr : attrs) outattrs dr =
  let cp attr' = gcattrsK attrs (attr' : outattrs) dr
  in case attr of
       GCForeground colname ->
         allocNamedColorPixel defaultColormap colname $ \fg ->
	 gcattrsK attrs (GCForeground fg : outattrs) dr
       GCBackground colname ->
         allocNamedColorPixel defaultColormap colname $ \fg ->
	 gcattrsK attrs (GCBackground fg : outattrs) dr
       GCFont fname ->
         loadFont fname $ \font ->
	 gcattrsK attrs (GCFont font : outattrs) dr
       GCFunction f -> cp (GCFunction f)
       GCLineWidth w -> cp (GCLineWidth w)
       GCLineStyle s -> cp (GCLineStyle s)
       GCCapStyle s -> cp (GCCapStyle s)
       GCJoinStyle s -> cp (GCJoinStyle s)
       GCSubwindowMode m -> cp (GCSubwindowMode m)
       GCGraphicsExposures b -> cp (GCGraphicsExposures b)