Freetype re-enabled

* src/cairo_ft.ml, src/cairo_ft.mli, src/ml_cairo_ft.c: re-enable
freetype font backend bindings

* test/font.ml: adapt

* src/cairo.mli, src/cairo_png.mli: use `Any surface instead of 'a
surface everywhere

12 files changed, 125 insertions, 216 deletions

diff --git a/ChangeLog b/ChangeLog
index a96242d..75dd29b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,15 @@
 2005-07-18  Olivier Andrieu  <oliv__a@users.sourceforge.net>
 
+	* src/cairo_ft.ml, src/cairo_ft.mli, src/ml_cairo_ft.c: re-enable
+	freetype font backend bindings
+
+	* test/font.ml: adapt
+
+	* src/cairo.mli, src/cairo_png.mli: use `Any surface instead of 'a
+	surface everywhere
+
+2005-07-18  Olivier Andrieu  <oliv__a@users.sourceforge.net>
+
 	* configure.ac, README: require cairo 0.5.2
 	
 	* src/*: adapt to cairo 0.5.1 and 0.5.2 API changes (new status
diff --git a/src/Makefile b/src/Makefile
index 6698f0b..edc5317 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -30,10 +30,11 @@ cairo_SRC = cairo.mli cairo.ml \
 	    cairo_png.mli cairo_png.ml \
 	    cairo_pdf.mli cairo_pdf.ml \
 	    cairo_ps.mli cairo_ps.ml \
+            cairo_ft.mli cairo_ft.ml \
             ml_cairo_wrappers.c \
             ml_cairo.c ml_cairo_status.c ml_cairo_bigarr.c ml_cairo_path.c \
 	    ml_cairo_surface.c ml_cairo_pattern.c ml_cairo_matrix.c \
-	    ml_cairo_font.c \
+	    ml_cairo_font.c ml_cairo_ft.c \
 	    ml_cairo_png.c ml_cairo_pdf.c ml_cairo_ps.c
 
 cairo.cma : $(call mlobjs,$(cairo_SRC))
@@ -92,7 +93,7 @@ endif
           for lib in dll*.so ; do \
             ln -s $(INSTALLDIR)/$$lib $(DESTDIR)$(OCAMLLIB)/stublibs ; done ; fi
 
-DOCFILES = cairo.mli cairo_bigarray.mli cairo_png.mli cairo_pdf.mli cairo_ps.mli
+DOCFILES = cairo.mli cairo_bigarray.mli cairo_png.mli cairo_pdf.mli cairo_ps.mli cairo_ft.mli
 ifdef LABLGTKDIR
 DOCFILES += cairo_lablgtk.mli
 ifdef GTKCAIRO_CFLAGS
diff --git a/src/cairo.ml b/src/cairo.ml
index 30768d4..d40c25a 100644
--- a/src/cairo.ml
+++ b/src/cairo.ml
@@ -28,7 +28,7 @@ let init = Callback.register_exception "cairo_status_exn" (Error NULL_POINTER)
 type t
 type -'a surface
 type -'a pattern
-type font_face
+type -'a font_face
 
 type point = { x : float ; y : float }
 type matrix = {
@@ -37,7 +37,7 @@ type matrix = {
     x0 : float ; y0 : float 
   }
 
-external create : 'a surface -> t = "ml_cairo_create"
+external create : [> `Any] surface -> t = "ml_cairo_create"
 external save : t -> unit = "ml_cairo_save"
 external restore : t -> unit = "ml_cairo_restore"
 
@@ -64,8 +64,8 @@ external set_operator : t -> operator -> unit = "ml_cairo_set_operator"
 
 external set_source_rgb  : t -> red:float -> green:float -> blue:float -> unit = "ml_cairo_set_source_rgb"
 external set_source_rgba : t -> red:float -> green:float -> blue:float -> alpha:float ->unit = "ml_cairo_set_source_rgba"
-external set_source : t -> 'a pattern -> unit = "ml_cairo_set_source"
-external set_source_surface : t -> 'a surface -> float -> float -> unit = "ml_cairo_set_source_surface"
+external set_source : t -> [> `Any] pattern -> unit = "ml_cairo_set_source"
+external set_source_surface : t -> [> `Any] surface -> float -> float -> unit = "ml_cairo_set_source_surface"
 
 external set_tolerance : t -> float -> unit = "ml_cairo_set_tolerance"
 
@@ -115,8 +115,8 @@ external close_path : t -> unit = "ml_cairo_close_path"
 external paint : t -> unit = "ml_cairo_paint"
 external paint_with_alpha : t -> float -> unit = "ml_cairo_paint_with_alpha"
 
-external mask : t -> 'a pattern -> unit = "ml_cairo_mask"
-external mask_surface : t -> 'a surface -> surface_x:float -> surface_y:float -> unit = "ml_cairo_mask_surface"
+external mask : t -> [> `Any] pattern -> unit = "ml_cairo_mask"
+external mask_surface : t -> [> `Any] surface -> surface_x:float -> surface_y:float -> unit = "ml_cairo_mask_surface"
 
 external stroke : t -> unit = "ml_cairo_stroke"
 external stroke_preserve : t -> unit = "ml_cairo_stroke_preserve"
@@ -162,16 +162,16 @@ external set_font_matrix : t -> matrix -> unit = "ml_cairo_set_font_matrix"
 external get_font_matrix : t -> matrix = "ml_cairo_get_font_matrix"
 external show_text : t -> string -> unit = "ml_cairo_show_text"
 external show_glyphs : t -> glyph array -> unit = "ml_cairo_show_glyphs"
-external get_font_face : t -> font_face = "ml_cairo_get_font_face"
+external get_font_face : t -> [`Any] font_face = "ml_cairo_get_font_face"
 external font_extents : t -> font_extents = "ml_cairo_font_extents"
-external set_font_face : t -> font_face -> unit = "ml_cairo_set_font_face"
+external set_font_face : t -> [> `Any] font_face -> unit = "ml_cairo_set_font_face"
 external text_extents : t -> string -> text_extents = "ml_cairo_text_extents"
 external glyph_extents : t -> glyph array -> text_extents = "ml_cairo_glyph_extents"
 external text_path : t -> string -> unit = "ml_cairo_text_path"
 external glyph_path : t -> glyph array -> unit = "ml_cairo_glyph_path"
 
 external get_operator : t -> operator = "ml_cairo_get_operator"
-external get_source : t -> 'a pattern = "ml_cairo_get_source"
+external get_source : t -> [`Any] pattern = "ml_cairo_get_source"
 external get_tolerance : t -> float = "ml_cairo_get_tolerance"
 external get_current_point : t -> point = "ml_cairo_get_current_point"
 external get_fill_rule : t -> fill_rule = "ml_cairo_get_fill_rule"
@@ -180,7 +180,7 @@ external get_line_cap : t -> line_cap = "ml_cairo_get_line_cap"
 external get_line_join : t -> line_join = "ml_cairo_get_line_join"
 external get_miter_limit : t -> float = "ml_cairo_get_miter_limit"
 external get_matrix : t -> matrix = "ml_cairo_get_matrix"
-external get_target : t -> 'a surface = "ml_cairo_get_target"
+external get_target : t -> [`Any] surface = "ml_cairo_get_target"
 
 type flat_path = [
   | `MOVE_TO of point
@@ -210,11 +210,11 @@ type content =
   | CONTENT_ALPHA
   | CONTENT_COLOR_ALPHA
 
-external surface_create_similar : 'a surface -> content -> width:int -> height:int -> 'a surface = "ml_cairo_surface_create_similar"
+external surface_create_similar : [> `Any] surface -> content -> width:int -> height:int -> [`Any] surface = "ml_cairo_surface_create_similar"
 
-external surface_finish : 'a surface -> unit = "ml_cairo_surface_finish"
+external surface_finish : [> `Any] surface -> unit = "ml_cairo_surface_finish"
 
-external surface_set_device_offset : 'a surface -> float -> float -> unit = "ml_cairo_surface_set_device_offset"
+external surface_set_device_offset : [> `Any] surface -> float -> float -> unit = "ml_cairo_surface_set_device_offset"
 
 
 type image_surface = [`Any|`Image] surface
@@ -252,15 +252,15 @@ type gradient_pattern = [`Any|`Gradient] pattern
 module Pattern = struct
 external create_rgb  : red:float -> green:float -> blue:float -> solid_pattern = "ml_cairo_pattern_create_rgb"
 external create_rgba : red:float -> green:float -> blue:float -> alpha:float -> solid_pattern = "ml_cairo_pattern_create_rgba"
-external create_for_surface : 'a surface -> surface_pattern = "ml_cairo_pattern_create_for_surface"
+external create_for_surface : [> `Any] surface -> surface_pattern = "ml_cairo_pattern_create_for_surface"
 external create_linear : x0:float -> y0:float -> x1:float -> y1:float -> gradient_pattern = "ml_cairo_pattern_create_linear"
 external create_radial : cx0:float -> cy0:float -> radius0:float -> cx1:float -> cy1:float -> radius1:float -> gradient_pattern = "ml_cairo_pattern_create_radial_bc" "ml_cairo_pattern_create_radial"
 
 external add_color_stop_rgb  : [>`Gradient] pattern -> off:float -> red:float -> green:float -> blue:float -> unit = "ml_cairo_pattern_add_color_stop_rgb"
 external add_color_stop_rgba : [>`Gradient] pattern -> off:float -> red:float -> green:float -> blue:float -> alpha:float -> unit = "ml_cairo_pattern_add_color_stop_rgba_bc" "ml_cairo_pattern_add_color_stop_rgba"
 
-external set_matrix : 'a pattern -> matrix -> unit = "ml_cairo_pattern_set_matrix"
-external get_matrix : 'a pattern -> matrix = "ml_cairo_pattern_get_matrix"
+external set_matrix : [> `Any] pattern -> matrix -> unit = "ml_cairo_pattern_set_matrix"
+external get_matrix : [> `Any] pattern -> matrix = "ml_cairo_pattern_get_matrix"
 
 external set_extend : [> `Surface] pattern -> extend -> unit = "ml_cairo_pattern_set_extend"
 external get_extend : [> `Surface] pattern -> extend = "ml_cairo_pattern_get_extend"
@@ -294,9 +294,9 @@ end
 
 (* fonts *)
 module Scaled_Font = struct
-type t
+type -'a t
 
-external create : font_face -> matrix -> matrix -> t = "ml_cairo_scaled_font_create"
-external font_extents : t -> font_extents = "ml_cairo_scaled_font_extents"
-external glyph_extents : t -> glyph array -> text_extents = "ml_cairo_scaled_font_glyph_extents"
+external create : ([>`Any] as 'a) font_face -> matrix -> matrix -> 'a t = "ml_cairo_scaled_font_create"
+external font_extents : [> `Any] t -> font_extents = "ml_cairo_scaled_font_extents"
+external glyph_extents : [> `Any] t -> glyph array -> text_extents = "ml_cairo_scaled_font_glyph_extents"
 end
diff --git a/src/cairo.mli b/src/cairo.mli
index 1396cc5..56164c1 100644
--- a/src/cairo.mli
+++ b/src/cairo.mli
@@ -34,7 +34,7 @@ val init : unit
 type t
 type -'a surface
 type -'a pattern
-type font_face
+type -'a font_face
 
 type point = { x : float ; y : float }
 type matrix = {
@@ -45,7 +45,7 @@ type matrix = {
 
 (** {3 Core API} *)
 
-val create : 'a surface -> t
+val create : [> `Any] surface -> t
 external save    : t -> unit = "ml_cairo_save"
 external restore : t -> unit = "ml_cairo_restore"
 
@@ -78,8 +78,8 @@ external set_operator : t -> operator -> unit = "ml_cairo_set_operator"
 
 external set_source_rgb  : t -> red:float -> green:float -> blue:float -> unit = "ml_cairo_set_source_rgb"
 external set_source_rgba : t -> red:float -> green:float -> blue:float -> alpha:float ->unit = "ml_cairo_set_source_rgba"
-external set_source : t -> 'a pattern -> unit = "ml_cairo_set_source"
-external set_source_surface : t -> 'a surface -> float -> float -> unit = "ml_cairo_set_source_surface"
+external set_source : t -> [> `Any] pattern -> unit = "ml_cairo_set_source"
+external set_source_surface : t -> [> `Any] surface -> float -> float -> unit = "ml_cairo_set_source_surface"
 
 external set_tolerance : t -> float -> unit = "ml_cairo_set_tolerance"
 
@@ -135,8 +135,8 @@ external close_path : t -> unit = "ml_cairo_close_path"
 external paint : t -> unit = "ml_cairo_paint"
 external paint_with_alpha : t -> float -> unit = "ml_cairo_paint_with_alpha"
 
-external mask : t -> 'a pattern -> unit = "ml_cairo_mask"
-external mask_surface : t -> 'a surface -> surface_x:float -> surface_y:float -> unit = "ml_cairo_mask_surface"
+external mask : t -> [> `Any] pattern -> unit = "ml_cairo_mask"
+external mask_surface : t -> [> `Any] surface -> surface_x:float -> surface_y:float -> unit = "ml_cairo_mask_surface"
 
 external stroke : t -> unit = "ml_cairo_stroke"
 external stroke_preserve : t -> unit = "ml_cairo_stroke_preserve"
@@ -186,9 +186,9 @@ external set_font_matrix : t -> matrix -> unit = "ml_cairo_set_font_matrix"
 external get_font_matrix : t -> matrix = "ml_cairo_get_font_matrix"
 external show_text : t -> string -> unit = "ml_cairo_show_text"
 external show_glyphs : t -> glyph array -> unit = "ml_cairo_show_glyphs"
-external get_font_face : t -> font_face = "ml_cairo_get_font_face"
+external get_font_face : t -> [`Any] font_face = "ml_cairo_get_font_face"
 external font_extents : t -> font_extents = "ml_cairo_font_extents"
-external set_font_face : t -> font_face -> unit = "ml_cairo_set_font_face"
+external set_font_face : t -> [> `Any] font_face -> unit = "ml_cairo_set_font_face"
 external text_extents : t -> string -> text_extents = "ml_cairo_text_extents"
 external glyph_extents : t -> glyph array -> text_extents = "ml_cairo_glyph_extents"
 external text_path : t -> string -> unit = "ml_cairo_text_path"
@@ -197,7 +197,7 @@ external glyph_path : t -> glyph array -> unit = "ml_cairo_glyph_path"
 (** {4 Renderer state querying} *)
 
 external get_operator : t -> operator = "ml_cairo_get_operator"
-external get_source : t -> 'a pattern = "ml_cairo_get_source"
+external get_source : t -> [`Any] pattern = "ml_cairo_get_source"
 external get_tolerance : t -> float = "ml_cairo_get_tolerance"
 external get_current_point : t -> point = "ml_cairo_get_current_point"
 external get_fill_rule : t -> fill_rule = "ml_cairo_get_fill_rule"
@@ -206,7 +206,7 @@ external get_line_cap : t -> line_cap = "ml_cairo_get_line_cap"
 external get_line_join : t -> line_join = "ml_cairo_get_line_join"
 external get_miter_limit : t -> float = "ml_cairo_get_miter_limit"
 external get_matrix : t -> matrix = "ml_cairo_get_matrix"
-external get_target : t -> 'a surface = "ml_cairo_get_target"
+external get_target : t -> [`Any] surface = "ml_cairo_get_target"
 
 type flat_path = [
   | `MOVE_TO of point
@@ -227,11 +227,11 @@ type content =
   | CONTENT_ALPHA
   | CONTENT_COLOR_ALPHA
 
-external surface_create_similar : 'a surface -> content -> width:int -> height:int -> 'a surface = "ml_cairo_surface_create_similar"
+external surface_create_similar : [> `Any] surface -> content -> width:int -> height:int -> [`Any] surface = "ml_cairo_surface_create_similar"
 
-external surface_finish : 'a surface -> unit = "ml_cairo_surface_finish"
+external surface_finish : [> `Any] surface -> unit = "ml_cairo_surface_finish"
 
-external surface_set_device_offset : 'a surface -> float -> float -> unit = "ml_cairo_surface_set_device_offset"
+external surface_set_device_offset : [> `Any] surface -> float -> float -> unit = "ml_cairo_surface_set_device_offset"
 
 (** {4 Image surface} *)
 
@@ -270,15 +270,15 @@ type filter =
 module Pattern : sig
 external create_rgb  : red:float -> green:float -> blue:float -> solid_pattern = "ml_cairo_pattern_create_rgb"
 external create_rgba : red:float -> green:float -> blue:float -> alpha:float -> solid_pattern = "ml_cairo_pattern_create_rgba"
-external create_for_surface : 'a surface -> surface_pattern = "ml_cairo_pattern_create_for_surface"
+external create_for_surface : [> `Any] surface -> surface_pattern = "ml_cairo_pattern_create_for_surface"
 external create_linear : x0:float -> y0:float -> x1:float -> y1:float -> gradient_pattern = "ml_cairo_pattern_create_linear"
 external create_radial : cx0:float -> cy0:float -> radius0:float -> cx1:float -> cy1:float -> radius1:float -> gradient_pattern = "ml_cairo_pattern_create_radial_bc" "ml_cairo_pattern_create_radial"
 
 external add_color_stop_rgb  : [>`Gradient] pattern -> off:float -> red:float -> green:float -> blue:float -> unit = "ml_cairo_pattern_add_color_stop_rgb"
 external add_color_stop_rgba : [>`Gradient] pattern -> off:float -> red:float -> green:float -> blue:float -> alpha:float -> unit = "ml_cairo_pattern_add_color_stop_rgba_bc" "ml_cairo_pattern_add_color_stop_rgba"
 
-external set_matrix : 'a pattern -> matrix -> unit = "ml_cairo_pattern_set_matrix"
-external get_matrix : 'a pattern -> matrix = "ml_cairo_pattern_get_matrix"
+external set_matrix : [> `Any] pattern -> matrix -> unit = "ml_cairo_pattern_set_matrix"
+external get_matrix : [> `Any] pattern -> matrix = "ml_cairo_pattern_get_matrix"
 
 external set_extend : [> `Surface] pattern -> extend -> unit = "ml_cairo_pattern_set_extend"
 external get_extend : [> `Surface] pattern -> extend = "ml_cairo_pattern_get_extend"
@@ -310,9 +310,9 @@ end
 
 (** Scaled fonts functions *)
 module Scaled_Font : sig
-type t
+type -'a t
 
-external create : font_face -> matrix -> matrix -> t = "ml_cairo_scaled_font_create"
-external font_extents : t -> font_extents = "ml_cairo_scaled_font_extents"
-external glyph_extents : t -> glyph array -> text_extents = "ml_cairo_scaled_font_glyph_extents"
+external create : ([>`Any] as 'a) font_face -> matrix -> matrix -> 'a t = "ml_cairo_scaled_font_create"
+external font_extents : [> `Any] t -> font_extents = "ml_cairo_scaled_font_extents"
+external glyph_extents : [>`Any] t -> glyph array -> text_extents = "ml_cairo_scaled_font_glyph_extents"
 end
diff --git a/src/cairo_ft.ml b/src/cairo_ft.ml
index 7c53fc3..ad39356 100644
--- a/src/cairo_ft.ml
+++ b/src/cairo_ft.ml
@@ -22,9 +22,10 @@ type fc_pattern
 external fc_name_parse   : string -> fc_pattern = "ml_FcNameParse"
 external fc_name_unparse : fc_pattern -> string = "ml_FcNameUnparse"
 
-external font_create : ft_library -> fc_pattern -> Cairo.font = "ml_cairo_ft_font_create"
-external font_create_for_ft_face : ft_face -> Cairo.font = "ml_cairo_ft_font_create_for_ft_face"
-external font_lock_face : Cairo.font -> ft_face = "ml_cairo_ft_font_lock_face"
-external font_unlock_face : Cairo.font -> unit = "ml_cairo_ft_font_unlock_face"
+type font_face = [`Any|`FT] Cairo.font_face
 
-external font_get_pattern : Cairo.font -> fc_pattern = "ml_cairo_ft_font_get_pattern"
+external font_face_create_for_pattern : fc_pattern -> font_face     = "ml_cairo_ft_font_face_create_for_pattern"
+external font_face_create_for_ft_face : ft_face -> int -> font_face = "ml_cairo_ft_font_face_create_for_ft_face"
+
+external font_lock_face   : [> `FT] Cairo.Scaled_Font.t -> ft_face = "ml_cairo_ft_scaled_font_lock_face"
+external font_unlock_face : [> `FT] Cairo.Scaled_Font.t -> unit    = "ml_cairo_ft_scaled_font_unlock_face"
diff --git a/src/cairo_ft.mli b/src/cairo_ft.mli
index e298366..296def5 100644
--- a/src/cairo_ft.mli
+++ b/src/cairo_ft.mli
@@ -22,15 +22,16 @@ external done_face : ft_face -> unit = "ml_FT_Done_Face"
 
 type fc_pattern
 external fc_name_parse : string -> fc_pattern = "ml_FcNameParse"
+(** this is a hack: this actually calls FcNameParse, FcConfigSubstitute, 
+    FcDefaultSubstitute and FcFontMatch *)
 external fc_name_unparse : fc_pattern -> string = "ml_FcNameUnparse"
 
-external font_create : ft_library -> fc_pattern -> Cairo.font
-  = "ml_cairo_ft_font_create"
-external font_create_for_ft_face : ft_face -> Cairo.font
-  = "ml_cairo_ft_font_create_for_ft_face"
+type font_face = [`Any|`FT] Cairo.font_face
 
+external font_face_create_for_pattern : fc_pattern -> font_face
+  = "ml_cairo_ft_font_face_create_for_pattern"
+external font_face_create_for_ft_face : ft_face -> int -> font_face
+  = "ml_cairo_ft_font_face_create_for_ft_face"
 
-external font_lock_face : Cairo.font -> ft_face = "ml_cairo_ft_font_lock_face"
-external font_unlock_face : Cairo.font -> unit = "ml_cairo_ft_font_unlock_face"
-
-external font_get_pattern : Cairo.font -> fc_pattern = "ml_cairo_ft_font_get_pattern"
+external font_lock_face   : [>`FT] Cairo.Scaled_Font.t -> ft_face = "ml_cairo_ft_scaled_font_lock_face"
+external font_unlock_face : [>`FT] Cairo.Scaled_Font.t -> unit    = "ml_cairo_ft_scaled_font_unlock_face"
diff --git a/src/cairo_png.ml b/src/cairo_png.ml
index 3816d0d..78b3166 100644
--- a/src/cairo_png.ml
+++ b/src/cairo_png.ml
@@ -32,7 +32,7 @@ external image_surface_create_from_stream :
 
 
 external surface_write_to_stream_unsafe : 
-  'a Cairo.surface -> (string -> int -> unit) -> unit = "ml_cairo_surface_write_to_png_stream_unsafe"
+  [> `Any] Cairo.surface -> (string -> int -> unit) -> unit = "ml_cairo_surface_write_to_png_stream_unsafe"
 
 let unsafe_output_string oc s n =
   for i = 0 to n - 1 do
@@ -45,7 +45,7 @@ let surface_write_to_channel surf oc =
     (unsafe_output_string oc)
 
 let surface_write_to_file surf fname =
-  let oc = open_out fname in
+  let oc = open_out_bin fname in
   try
     surface_write_to_channel surf oc ;
     close_out oc
@@ -54,4 +54,4 @@ let surface_write_to_file surf fname =
     raise exn
 
 external surface_write_to_stream : 
-  'a Cairo.surface -> (string -> unit) -> unit = "ml_cairo_surface_write_to_png_stream"
+  [> `Any] Cairo.surface -> (string -> unit) -> unit = "ml_cairo_surface_write_to_png_stream"
diff --git a/src/cairo_png.mli b/src/cairo_png.mli
index 9f474b5..6f082bb 100644
--- a/src/cairo_png.mli
+++ b/src/cairo_png.mli
@@ -19,10 +19,10 @@ external image_surface_create_from_stream :
 
 
 val surface_write_to_channel : 
-  'a Cairo.surface -> out_channel -> unit
+  [> `Any] Cairo.surface -> out_channel -> unit
 
 val surface_write_to_file : 
-  'a Cairo.surface -> string -> unit
+  [> `Any] Cairo.surface -> string -> unit
 
 external surface_write_to_stream : 
-  'a Cairo.surface -> (string -> unit) -> unit = "ml_cairo_surface_write_to_png_stream"
+  [> `Any] Cairo.surface -> (string -> unit) -> unit = "ml_cairo_surface_write_to_png_stream"
diff --git a/src/caml_io.h b/src/caml_io.h
deleted file mode 100644
index 2f17f12..0000000
--- a/src/caml_io.h
+++ /dev/null
@@ -1,112 +0,0 @@
-/***********************************************************************/
-/*                                                                     */
-/*                           Objective Caml                            */
-/*                                                                     */
-/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
-/*                                                                     */
-/*  Copyright 1996 Institut National de Recherche en Informatique et   */
-/*  en Automatique.  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.     */
-/*                                                                     */
-/***********************************************************************/
-
-/* $Id: caml_io.h,v 1.1 2003-11-18 19:02:25 oandrieu Exp $ */
-
-/* Buffered input/output */
-
-#ifndef _io_
-#define _io_
-
-#include "caml/misc.h"
-#include "caml/mlvalues.h"
-
-#ifndef IO_BUFFER_SIZE
-#define IO_BUFFER_SIZE 4096
-#endif
-
-#ifdef HAS_OFF_T
-#include <sys/types.h>
-typedef off_t file_offset;
-#else
-typedef long file_offset;
-#endif
-
-struct channel {
-  int fd;                       /* Unix file descriptor */
-  file_offset offset;           /* Absolute position of fd in the file */
-  char * end;                   /* Physical end of the buffer */
-  char * curr;                  /* Current position in the buffer */
-  char * max;                   /* Logical end of the buffer (for input) */
-  void * mutex;                 /* Placeholder for mutex (for systhreads) */
-  struct channel * next;        /* Linear chaining of channels (flush_all) */
-  int revealed;                 /* For Cash only */
-  int old_revealed;             /* For Cash only */
-  int refcount;                 /* For flush_all and for Cash */
-  char buff[IO_BUFFER_SIZE];    /* The buffer itself */
-};
-
-/* For an output channel:
-     [offset] is the absolute position of the beginning of the buffer [buff].
-   For an input channel:
-     [offset] is the absolute position of the logical end of the buffer, [max].
-*/
-
-/* Functions and macros that can be called from C.  Take arguments of
-   type struct channel *.  No locking is performed. */
-
-#define putch(channel, ch) do{                                            \
-  if ((channel)->curr >= (channel)->end) flush_partial(channel);          \
-  *((channel)->curr)++ = (ch);                                            \
-}while(0)
-
-#define getch(channel)                                                      \
-  ((channel)->curr >= (channel)->max                                        \
-   ? refill(channel)                                                        \
-   : (unsigned char) *((channel))->curr++)
-
-CAMLextern struct channel * open_descriptor_in (int);
-CAMLextern struct channel * open_descriptor_out (int);
-CAMLextern void close_channel (struct channel *);
-CAMLextern int channel_binary_mode (struct channel *);
-
-CAMLextern int flush_partial (struct channel *);
-CAMLextern void flush (struct channel *);
-CAMLextern void putword (struct channel *, uint32);
-CAMLextern int putblock (struct channel *, char *, long);
-CAMLextern void really_putblock (struct channel *, char *, long);
-
-CAMLextern unsigned char refill (struct channel *);
-CAMLextern uint32 getword (struct channel *);
-CAMLextern int getblock (struct channel *, char *, long);
-CAMLextern int really_getblock (struct channel *, char *, long);
-
-/* Extract a struct channel * from the heap object representing it */
-
-#define Channel(v) (*((struct channel **) (Data_custom_val(v))))
-
-/* The locking machinery */
-
-CAMLextern void (*channel_mutex_free) (struct channel *);
-CAMLextern void (*channel_mutex_lock) (struct channel *);
-CAMLextern void (*channel_mutex_unlock) (struct channel *);
-CAMLextern void (*channel_mutex_unlock_exn) (void);
-
-#define Lock(channel) \
-  if (channel_mutex_lock != NULL) (*channel_mutex_lock)(channel)
-#define Unlock(channel) \
-  if (channel_mutex_unlock != NULL) (*channel_mutex_unlock)(channel)
-#define Unlock_exn() \
-  if (channel_mutex_unlock_exn != NULL) (*channel_mutex_unlock_exn)()
-
-/* Conversion between file_offset and int64 */
-
-#ifdef ARCH_INT64_TYPE
-#define Val_file_offset(fofs) copy_int64(fofs)
-#define File_offset_val(v) ((file_offset) Int64_val(v))
-#else
-CAMLextern value Val_file_offset(file_offset fofs);
-CAMLextern file_offset File_offset_val(value v);
-#endif
-
-#endif /* _io_ */
diff --git a/src/ml_cairo_ft.c b/src/ml_cairo_ft.c
index 150e19e..cbb955f 100644
--- a/src/ml_cairo_ft.c
+++ b/src/ml_cairo_ft.c
@@ -24,13 +24,21 @@ ml_raise_FT_Error (FT_Error err)
     {
       caml_exn = caml_named_value ("FT_exn");
       if (caml_exn == NULL)
-	failwith ("freetype error");
+	caml_failwith ("freetype error");
     }
 
-  raise_with_arg (*caml_exn, Val_int (err));
+  caml_raise_with_arg (*caml_exn, Val_int (err));
 }
 
-#define FT_Library_val(v) (FT_Library)Pointer_val(v)
+static value
+Val_ptr (void *p)
+{
+  value v = caml_alloc_small (1, Abstract_tag);
+  Field (v, 0) = Val_bp (p);
+  return v;
+}
+
+#define FT_Library_val(v) (FT_Library)(Field(v, 0))
 
 CAMLprim value
 ml_FT_Init_FreeType (value unit)
@@ -47,13 +55,13 @@ ml_FT_Done_FreeType (value lib)
   return Val_unit;
 }
 
-#define FT_Face_val(v) (FT_Face)Pointer_val(v)
+#define FT_Face_val(v) (FT_Face)(Field(v, 0))
 
 CAMLprim value
 ml_FT_New_Face (value lib, value o_index, value path)
 {
   FT_Face face;
-  FT_Long index = Option_val(o_index, Long_val, 0);
+  FT_Long index = Is_block(o_index) ? Long_val(Field(o_index, 0)) : 0;
   ml_raise_FT_Error (FT_New_Face (FT_Library_val (lib),
 				  String_val (path),
 				  index, &face));
@@ -68,10 +76,23 @@ ml_FT_Done_Face (value face)
 }
 
 /* minimal Fontconfig interface */
-Make_Val_final_pointer (FcPattern, Id, FcPatternDestroy, 10)
-#define FcPattern_val(v) (FcPattern *)Pointer_val(v)
+wMake_Val_final_pointer (FcPattern, FcPatternDestroy, 10)
+#define FcPattern_val(v) wPointer_val(FcPattern,v)
 
-ML_1 (FcNameParse, String_val, Val_FcPattern)
+#define UString_val(v) ((unsigned char *) (v))
+
+CAMLprim value
+ml_FcNameParse (value s)
+{
+  FcPattern *p1, *p2;
+  FcResult res;
+  p1 = FcNameParse (UString_val(s));
+  FcConfigSubstitute (NULL, p1, FcMatchPattern);
+  FcDefaultSubstitute (p1);
+  p2 = FcFontMatch (NULL, p1, &res);
+  FcPatternDestroy (p1);
+  return Val_FcPattern (p2);
+}
 
 CAMLprim value
 ml_FcNameUnparse (value patt)
@@ -80,27 +101,17 @@ ml_FcNameUnparse (value patt)
   value r;
   s = FcNameUnparse (FcPattern_val (patt));
   if (s == NULL)
-    failwith ("FcNameUnparse");
-  r = copy_string (s);
+    caml_failwith ("FcNameUnparse");
+  r = caml_copy_string ((char *) s);
   free (s);
   return r;
 }
 
 /* cairo Fontconfig/Freetype font backend */
-ML_2 (cairo_ft_font_create, FcPattern_val, cairo_matrix_t_val, Val_cairo_font_t)
-ML_3 (cairo_ft_font_create_for_ft_face, FT_Face_val, Int_val, cairo_matrix_t_val, Val_cairo_font_t)
-ML_1 (cairo_ft_font_lock_face, cairo_font_t_val, Val_ptr)
-ML_1 (cairo_ft_font_unlock_face, cairo_font_t_val, Unit)
-CAMLprim value
-ml_cairo_ft_font_get_pattern (value font)
-{
-  FcPattern *p;
-  p = cairo_ft_font_get_pattern (cairo_font_t_val (font));
-  if (p == NULL)
-    failwith ("cairo_ft_font_get_pattern: NULL pointer");
-  FcPatternReference (p);
-  return Val_FcPattern (p);
-}
+wML_1 (cairo_ft_font_face_create_for_pattern, FcPattern_val, Val_cairo_font_face_t)
+wML_2 (cairo_ft_font_face_create_for_ft_face, FT_Face_val, Int_val, Val_cairo_font_face_t)
+wML_1 (cairo_ft_scaled_font_lock_face, cairo_scaled_font_t_val, Val_ptr)
+wML_1 (cairo_ft_scaled_font_unlock_face, cairo_scaled_font_t_val, Unit)
 
 #else
 
@@ -110,10 +121,9 @@ Unsupported (ml_FT_New_Face)
 Unsupported (ml_FT_Done_Face)
 Unsupported (ml_FcNameParse)
 Unsupported (ml_FcNameUnparse)
-Unsupported (ml_cairo_ft_font_create)
+Unsupported (ml_cairo_ft_font_create_for_pattern)
 Unsupported (ml_cairo_ft_font_create_for_ft_face)
-Unsupported (ml_cairo_ft_font_lock_face)
-Unsupported (ml_cairo_ft_font_unlock_face)
-Unsupported (ml_cairo_ft_font_get_pattern)
+Unsupported (ml_cairo_ft_scaled_font_lock_face)
+Unsupported (ml_cairo_ft_scaled_font_unlock_face)
 
 #endif /* CAIRO_HAS_FT_FONT */
diff --git a/test/Makefile b/test/Makefile
index d570701..af59a38 100644
--- a/test/Makefile
+++ b/test/Makefile
@@ -3,7 +3,7 @@ include ../config.make
 
 TARGETS = basket kapow
 ifdef LABLGTKDIR
-TARGETS += text demo spline knockout # font
+TARGETS += text demo spline knockout font
 ifdef GTKCAIRO_CFLAGS
 TARGETS += cube
 endif
diff --git a/test/font.ml b/test/font.ml
index dcd3e46..c5a3480 100644
--- a/test/font.ml
+++ b/test/font.ml
@@ -14,34 +14,32 @@ let main font_arg =
     if Sys.file_exists font_arg
     then
       let face = Cairo_ft.new_face ft font_arg in
-      let font = Cairo_ft.font_create_for_ft_face face in
+      let font = Cairo_ft.font_face_create_for_ft_face face 0 in
       (font, (fun () -> Cairo_ft.done_face face))
-    else
+    else begin
       let pattern = Cairo_ft.fc_name_parse font_arg in
-      let font = Cairo_ft.font_create ft pattern in
+      let font = Cairo_ft.font_face_create_for_pattern pattern in
       (font, ignore)
+    end
   in
 
-  let cr = Cairo.create () in
-  let file = Cairo_channel.open_out "test_font.png" in
-  Cairo.set_target_png ~cr ~file Cairo.FORMAT_ARGB32 ~width:200 ~height:200 ;
+  let s = Cairo.image_surface_create Cairo.FORMAT_ARGB32 ~width:200 ~height:200 in
+  let cr = Cairo.create s in
 
-  Cairo.set_font ~cr ~font ;
+  Cairo.set_font_face cr font ;
 
-  Cairo.scale_font cr 20. ;
+  Cairo.set_font_size cr 20. ;
   Cairo.move_to cr 10. 10. ;
   Cairo.rotate cr (pi /. 2.) ;
   Cairo.show_text cr "Hello World !" ;
 
-  Cairo.finalise_target ~cr ;
-  Cairo_channel.close file ;
+  Cairo_png.surface_write_to_file s "test_font.png" ;
 
   clean_up () ;
   Cairo_ft.done_freetype ft
 
 let _ =
   if Array.length Sys.argv < 2 then exit 1 ;
-  main Sys.argv.(1)
-
-
-
+  try main Sys.argv.(1)
+  with Cairo.Error s ->
+    Printf.eprintf "Cairo error: '%s'\n%!" (Cairo.string_of_status s)