module FontProperty (fontProperty) where

import Font(FontProp(..))
import InternAtom(internAtom,atomName)
import Xtypes(Atom(..))

-- The font_prop element of the FontStruct contains a list of FontProp,
-- each containing a pair of Int's: the first is the property name atom number,
-- the secind is the property value atom number. To get a property of a font
-- (which may or may not exist) it is necessary to try to get the atom
-- number for the property name, and, if successful, find out the element
-- of the list containing that number. Then, using the second number 
-- in the element found, retrieve the value. If more than one property 
-- with the same name is found, only the first will be returned.

fontProperty :: [FontProp] -> String -> (Maybe String -> f b ho) -> f b ho
fontProperty [FontProp]
fsprops String
propn Maybe String -> f b ho
cont = 
  let match :: Atom -> FontProp -> Bool
match Atom
an' (FontProp Atom
an Int
vn) = Atom
an' Atom -> Atom -> Bool
forall a. Eq a => a -> a -> Bool
== Atom
an
      valatom :: FontProp -> Int
valatom (FontProp Atom
an Int
vn) = Int
vn
  in  String -> Bool -> (Atom -> f b ho) -> f b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
String -> Bool -> (Atom -> f b ho) -> f b ho
internAtom String
propn Bool
True ((Atom -> f b ho) -> f b ho) -> (Atom -> f b ho) -> f b ho
forall a b. (a -> b) -> a -> b
$ \Atom
pna ->
      case Atom
pna of
        Atom Int
0 -> Maybe String -> f b ho
cont Maybe String
forall a. Maybe a
Nothing
        Atom
a ->
          case ((FontProp -> Int) -> [FontProp] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map FontProp -> Int
valatom ((FontProp -> Bool) -> [FontProp] -> [FontProp]
forall a. (a -> Bool) -> [a] -> [a]
filter (Atom -> FontProp -> Bool
match Atom
a) [FontProp]
fsprops)) of
            [] ->   Maybe String -> f b ho
cont Maybe String
forall a. Maybe a
Nothing
            Int
vn:[Int]
_ -> Atom -> (Maybe String -> f b ho) -> f b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
Atom -> (Maybe String -> f b ho) -> f b ho
atomName (Int -> Atom
Atom (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
vn)) ((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
vna -> Maybe String -> f b ho
cont Maybe String
vna