(***********************************************************************)

(*                                                                     *)

(*                 MLTk, Tcl/Tk interface of OCaml                     *)

(*                                                                     *)

(*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)

(*               projet Cristal, INRIA Rocquencourt                    *)

(*            Jacques Garrigue, Kyoto University RIMS                  *)

(*                                                                     *)

(*  Copyright 2002 Institut National de Recherche en Informatique et   *)

(*  en Automatique and Kyoto University.  All rights reserved.         *)

(*  This file is distributed under the terms of the GNU Library        *)

(*  General Public License, with the special exception on linking      *)

(*  described in file LICENSE found in the OCaml source tree.          *)

(*                                                                     *)

(***********************************************************************)

open Camltk

open Widget

let version = "$Id$"

(*

 * Finding fonts. Inspired by code in Ical by Sanjay Ghemawat.

 * Possibly bogus because some families use "i" for italic where others

 * use "o".

 * wght: bold, medium

 * slant: i, o, r

 * pxlsz: 8, 10, ...

*)

module StringSet = Set.Make(struct type t = string let compare = compare end)

let available_fonts = ref (StringSet.empty)

let get_canvas =

  Frx_misc.autodef (fun () -> Canvas.create Widget.default_toplevel [])

let find fmly wght slant pxlsz =

  let fontspec =

     "-*-"^fmly^"-"^wght^"-"^slant^"-normal-*-"^string_of_int pxlsz^"-*-*-*-*-*-iso8859-1" in

    if StringSet.mem fontspec !available_fonts then fontspec

    else

      let c = get_canvas() in

      try

        let tag = Canvas.create_text c (Pixels 0) (Pixels 0)

                                [Text "foo"; Font fontspec] in

           Canvas.delete c [tag];

           available_fonts := StringSet.add fontspec !available_fonts;

           fontspec

      with

        _ -> raise (Invalid_argument fontspec)