support patterns (requires cairo 0.1.21)

6 files changed, 209 insertions, 22 deletions

diff --git a/ChangeLog b/ChangeLog
index 9484066..d2e41ce 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2004-04-16  Olivier Andrieu  <oliv__a@users.sourceforge.net>
+
+	* src/cairo.ml, src/cairo.mli: support patterns 
+	
+	* configure.ac: require Cairo 0.1.21
+
+	* test/knockout.ml: update for pattern
+	
 2004-03-24  Olivier Andrieu  <oliv__a@users.sourceforge.net>
 
 	* src/cairo.ml, src/cairo.mli: add line_to_point and
diff --git a/configure.ac b/configure.ac
index 76fd647..af9292c 100644
--- a/configure.ac
+++ b/configure.ac
@@ -8,7 +8,7 @@ AC_PROG_OCAML()
 AC_CHECK_OCAML_MODULE(lablgtk, LABLGTKDIR, Gobject, +lablgtk2 +lablgtk)
 
 # Check for cairo
-PKG_CHECK_MODULES(CAIRO, cairo >= 0.1.17)
+PKG_CHECK_MODULES(CAIRO, cairo >= 0.1.21)
 
 # Check for gdk-pixbuf
 PKG_CHECK_MODULES(GDK, cairo gdk-2.0 gdk-pixbuf-2.0)
diff --git a/src/cairo.ml b/src/cairo.ml
index eeb7b11..4076e31 100644
--- a/src/cairo.ml
+++ b/src/cairo.ml
@@ -18,6 +18,7 @@ type point = { mutable x : float ; mutable y : float }
 type t
 type surface
 type matrix
+type pattern
 external create : unit -> t = "ml_cairo_create"
 external destroy : cr:t -> unit = "ml_cairo_destroy"
 external save : cr:t -> unit = "ml_cairo_save"
@@ -33,6 +34,7 @@ external set_target_ps :
     unit = "ml_cairo_set_target_ps_bc" "ml_cairo_set_target_ps"
 external set_target_png :
   cr:t -> file:Cairo_channel.t -> format -> width:float -> height:float -> unit = "ml_cairo_set_target_png"
+
 type operator =
     OPERATOR_CLEAR
   | OPERATOR_SRC
@@ -54,7 +56,7 @@ external set_rgb_color :
     unit = "ml_cairo_set_rgb_color"
 external set_alpha : cr:t -> alpha:float -> unit = "ml_cairo_set_alpha"
 external set_pattern :
-  cr:t -> pattern:surface -> unit = "ml_cairo_set_pattern"
+  cr:t -> pattern:pattern -> unit = "ml_cairo_set_pattern"
 external set_tolerance :
   cr:t -> tolerance:float -> unit = "ml_cairo_set_tolerance"
 type fill_rule =
@@ -129,6 +131,9 @@ external copy_page : cr:t -> unit = "ml_cairo_copy_page"
 external show_page : cr:t -> unit = "ml_cairo_show_page"
 external in_stroke : cr:t -> x:float -> y:float -> bool = "ml_cairo_in_stroke"
 external in_fill : cr:t -> x:float -> y:float -> bool = "ml_cairo_in_fill"
+external stroke_extents : cr:t -> float * float * float * float = "ml_cairo_stroke_extents"
+external fill_extents : cr:t -> float * float * float * float = "ml_cairo_fill_extents"
+external init_clip : cr:t -> unit = "ml_cairo_init_clip"
 external clip : cr:t -> unit = "ml_cairo_clip"
 type font
 type glyph = { index : int; glyph_x : float; glyph_y : float; }
@@ -192,6 +197,7 @@ external current_matrix :
   cr:t -> matrix:matrix -> unit = "ml_cairo_current_matrix"
 external current_target_surface :
   cr:t -> surface = "ml_cairo_current_target_surface"
+external current_pattern : cr:t -> pattern = "ml_cairo_current_pattern"
 external surface_create_for_image :
   image -> surface = "ml_cairo_surface_create_for_image"
 external surface_create_similar :
@@ -211,8 +217,30 @@ type filter =
   | FILTER_BEST
   | FILTER_NEAREST
   | FILTER_BILINEAR
+  | FILTER_GAUSSIAN
 external surface_set_filter :
   surface:surface -> filter:filter -> unit = "ml_cairo_surface_set_filter"
+external pattern_create_for_surface : surface -> pattern = "ml_cairo_pattern_create_for_surface"
+external pattern_create_linear : x0:float -> y0:float -> x1:float -> y1:float -> pattern 
+  = "ml_cairo_pattern_create_linear"
+external pattern_create_radial : 
+  cx0:float -> cy0:float -> radius0:float ->
+  cx1:float -> cy1:float -> radius1:float -> pattern 
+  = "ml_cairo_pattern_create_radial_bc" "ml_cairo_pattern_create_radial"
+external pattern_add_color_stop : 
+  pattern -> offset:float -> 
+  red:float -> green:float -> blue:float -> alpha:float -> unit 
+  = "ml_cairo_pattern_add_color_stop_bc" "ml_cairo_pattern_add_color_stop"
+external pattern_set_matrix : pattern -> matrix -> unit = "ml_cairo_pattern_set_matrix"
+external pattern_get_matrix : pattern -> matrix -> unit = "ml_cairo_pattern_get_matrix"
+type extend =
+  | EXTEND_NONE
+  | EXTEND_REPEAT
+  | EXTEND_REFLECT
+external pattern_set_extend : pattern -> extend -> unit = "ml_cairo_pattern_set_extend"
+external pattern_get_extend : pattern -> extend = "ml_cairo_pattern_get_extend"
+external pattern_set_filter : pattern -> filter -> unit = "ml_cairo_pattern_set_filter"
+external pattern_get_filter : pattern -> filter = "ml_cairo_pattern_get_filter"
 external image_surface_create :
   format:format -> width:int -> height:int ->
     surface = "ml_cairo_image_surface_create"
diff --git a/src/cairo.mli b/src/cairo.mli
index e5b850b..affcef0 100644
--- a/src/cairo.mli
+++ b/src/cairo.mli
@@ -20,6 +20,7 @@ type point = { mutable x : float ; mutable y : float }
 type t
 type surface
 type matrix
+type pattern
 type image
 
 type format = 
@@ -73,7 +74,7 @@ external set_rgb_color :
   cr:t -> red:float -> green:float -> blue:float -> unit
   = "ml_cairo_set_rgb_color"
 external set_alpha : cr:t -> alpha:float -> unit = "ml_cairo_set_alpha"
-external set_pattern : cr:t -> pattern:surface -> unit
+external set_pattern : cr:t -> pattern:pattern -> unit
   = "ml_cairo_set_pattern"
 external set_tolerance : cr:t -> tolerance:float -> unit
   = "ml_cairo_set_tolerance"
@@ -156,6 +157,9 @@ external fill : cr:t -> unit = "ml_cairo_fill"
 external in_stroke : cr:t -> x:float -> y:float -> bool = "ml_cairo_in_stroke"
 external in_fill : cr:t -> x:float -> y:float -> bool = "ml_cairo_in_fill"
 
+external stroke_extents : cr:t -> float * float * float * float = "ml_cairo_stroke_extents"
+external fill_extents : cr:t -> float * float * float * float = "ml_cairo_fill_extents"
+
 type flat_path = [
   | `MOVE_TO of point
   | `LINE_TO of point
@@ -173,6 +177,7 @@ external show_surface :
   = "ml_cairo_show_surface"
 external copy_page : cr:t -> unit = "ml_cairo_copy_page"
 external show_page : cr:t -> unit = "ml_cairo_show_page"
+external init_clip : cr:t -> unit = "ml_cairo_init_clip"
 external clip : cr:t -> unit = "ml_cairo_clip"
 
 (** {3 Text API} *)
@@ -235,7 +240,7 @@ external current_matrix : cr:t -> matrix:matrix -> unit
   = "ml_cairo_current_matrix"
 external current_target_surface : cr:t -> surface
   = "ml_cairo_current_target_surface"
-
+external current_pattern : cr:t -> pattern = "ml_cairo_current_pattern"
 
 (** {3 Surface API} *)
 
@@ -256,10 +261,38 @@ type filter =
   | FILTER_BEST
   | FILTER_NEAREST
   | FILTER_BILINEAR
+  | FILTER_GAUSSIAN
 external surface_set_filter : surface:surface -> filter:filter -> unit
   = "ml_cairo_surface_set_filter"
 external surface_finalise : surface -> unit = "ml_cairo_surface_finalise"
 
+(** {4 Pattern functions} *)
+external pattern_create_for_surface : surface -> pattern = "ml_cairo_pattern_create_for_surface"
+
+external pattern_create_linear : x0:float -> y0:float -> x1:float -> y1:float -> pattern 
+  = "ml_cairo_pattern_create_linear"
+external pattern_create_radial : 
+  cx0:float -> cy0:float -> radius0:float ->
+  cx1:float -> cy1:float -> radius1:float -> pattern 
+  = "ml_cairo_pattern_create_radial_bc" "ml_cairo_pattern_create_radial"
+
+external pattern_add_color_stop : 
+  pattern -> offset:float -> 
+  red:float -> green:float -> blue:float -> alpha:float -> unit 
+  = "ml_cairo_pattern_add_color_stop_bc" "ml_cairo_pattern_add_color_stop"
+
+external pattern_set_matrix : pattern -> matrix -> unit = "ml_cairo_pattern_set_matrix"
+external pattern_get_matrix : pattern -> matrix -> unit = "ml_cairo_pattern_get_matrix"
+
+type extend =
+  | EXTEND_NONE
+  | EXTEND_REPEAT
+  | EXTEND_REFLECT
+external pattern_set_extend : pattern -> extend -> unit = "ml_cairo_pattern_set_extend"
+external pattern_get_extend : pattern -> extend = "ml_cairo_pattern_get_extend"
+external pattern_set_filter : pattern -> filter -> unit = "ml_cairo_pattern_set_filter"
+external pattern_get_filter : pattern -> filter = "ml_cairo_pattern_get_filter"
+
 (** {4 Image surface} *)
 
 external image_surface_create :
diff --git a/src/ml_cairo.c b/src/ml_cairo.c
index 0972c15..a96b73e 100644
--- a/src/ml_cairo.c
+++ b/src/ml_cairo.c
@@ -15,10 +15,14 @@ Make_Val_final_pointer(cairo_t, Ignore, cairo_destroy, 20)
 
 Make_Val_final_pointer(cairo_surface_t, Ignore, cairo_surface_destroy, 20)
 #define cairo_surface_t_val(v) ((cairo_surface_t *)Pointer_val(v))
+
 Make_Val_final_pointer(cairo_matrix_t, Ignore, cairo_matrix_destroy, 100)
 #define cairo_matrix_t_val(v) ((cairo_matrix_t *)Pointer_val(v))
-ML_0(cairo_create, Val_cairo_t)
 
+Make_Val_final_pointer(cairo_pattern_t, Ignore, cairo_pattern_destroy, 20)
+#define cairo_pattern_t_val(v) ((cairo_pattern_t *)Pointer_val(v))
+
+ML_0(cairo_create, Val_cairo_t)
 ML_1(cairo_destroy, cairo_t_val, Unit)
 
 CAMLprim value
@@ -76,6 +80,21 @@ Unsupported(ml_cairo_set_target_ps)
 #endif /* CAIRO_HAS_PS_SURFACE */
 ML_bc6(cairo_set_target_ps)
 
+#ifdef CAIRO_HAS_PNG_SURFACE
+CAMLprim value
+ml_cairo_set_target_png(value v_cr, value v_file, value v_format,
+			value v_width, value v_height)
+{
+  cairo_set_target_png(cairo_t_val(v_cr), FILE_val(v_file),
+		       cairo_format_t_val(v_format),
+		       Double_val(v_width), Double_val(v_height));
+  check_cairo_status(v_cr);
+  return Val_unit;
+}
+#else
+Unsupported(ml_cairo_set_target_png)
+#endif /* CAIRO_HAS_PNG_SURFACE */
+
 static inline cairo_operator_t
 cairo_operator_t_val(value _v)
 {
@@ -153,7 +172,7 @@ ml_cairo_set_alpha(value v_cr, value v_alpha)
 CAMLprim value
 ml_cairo_set_pattern(value v_cr, value v_pattern)
 {
-  cairo_set_pattern(cairo_t_val(v_cr), cairo_surface_t_val(v_pattern));
+  cairo_set_pattern(cairo_t_val(v_cr), cairo_pattern_t_val(v_pattern));
   check_cairo_status(v_cr);
   return Val_unit;
 }
@@ -558,12 +577,56 @@ ml_cairo_in_fill(value v_cr, value v_x, value v_y)
 }
 
 CAMLprim value
+ml_cairo_stroke_extents(value v_cr)
+{
+  double x1, y1, x2, y2;
+  cairo_stroke_extents(cairo_t_val(v_cr), &x1, &y1, &x2, &y2);
+  check_cairo_status(v_cr);
+  {
+    CAMLparam0();
+    CAMLlocal1(t);
+    t = alloc_tuple(4);
+    Store_field(t, 0, copy_double(x1));
+    Store_field(t, 1, copy_double(y1));
+    Store_field(t, 2, copy_double(x2));
+    Store_field(t, 3, copy_double(y2));
+    CAMLreturn(t);
+  }
+}
+
+CAMLprim value
+ml_cairo_fill_extents(value v_cr)
+{
+  double x1, y1, x2, y2;
+  cairo_fill_extents(cairo_t_val(v_cr), &x1, &y1, &x2, &y2);
+  check_cairo_status(v_cr);
+  {
+    CAMLparam0();
+    CAMLlocal1(t);
+    t = alloc_tuple(4);
+    Store_field(t, 0, copy_double(x1));
+    Store_field(t, 1, copy_double(y1));
+    Store_field(t, 2, copy_double(x2));
+    Store_field(t, 3, copy_double(y2));
+    CAMLreturn(t);
+  }
+}
+
+CAMLprim value
 ml_cairo_clip(value v_cr)
 {
   cairo_clip(cairo_t_val(v_cr));
   check_cairo_status(v_cr);
   return Val_unit;
 }
+
+CAMLprim value
+ml_cairo_init_clip(value v_cr)
+{
+  cairo_init_clip(cairo_t_val(v_cr));
+  check_cairo_status(v_cr);
+  return Val_unit;
+}
 Make_Val_final_pointer(cairo_font_t, Ignore, cairo_font_destroy, 20)
 
 #define cairo_font_t_val(v) ((cairo_font_t *)Pointer_val(v))
@@ -790,6 +853,16 @@ ml_cairo_current_rgb_color(value cr)
 }
 
 CAMLprim value
+ml_cairo_current_pattern(value v_cr)
+{
+  cairo_pattern_t *c_ret;
+  c_ret = cairo_current_pattern(cairo_t_val(v_cr));
+  check_cairo_status(v_cr);
+  cairo_pattern_reference(c_ret);
+  return Val_cairo_pattern_t(c_ret);
+}
+
+CAMLprim value
 ml_cairo_current_alpha(value v_cr)
 {
   double c_ret;
@@ -907,9 +980,30 @@ cairo_filter_t_val(value _v)
 {
   const cairo_filter_t _conv_tab[] =
     { CAIRO_FILTER_FAST, CAIRO_FILTER_GOOD, CAIRO_FILTER_BEST,
-CAIRO_FILTER_NEAREST, CAIRO_FILTER_BILINEAR, };
+      CAIRO_FILTER_NEAREST, CAIRO_FILTER_BILINEAR, 
+      CAIRO_FILTER_GAUSSIAN };
   return _conv_tab[Int_val(_v)];
 }
+static inline value
+Val_cairo_filter_t(cairo_filter_t _s)
+{
+  switch(_s) 
+    {
+    case CAIRO_FILTER_FAST:
+      return Val_int(0);
+    case CAIRO_FILTER_GOOD:
+      return Val_int(1);
+    case CAIRO_FILTER_BEST:
+      return Val_int(2);
+    case CAIRO_FILTER_NEAREST:
+      return Val_int(3);
+    case CAIRO_FILTER_BILINEAR:
+      return Val_int(4);
+    case CAIRO_FILTER_GAUSSIAN:
+      return Val_int(5);
+    }
+  return 0;
+}
 ML_2(cairo_surface_set_filter, cairo_surface_t_val, cairo_filter_t_val, Val_cairo_status_t)
 
 ML_3(cairo_image_surface_create, cairo_format_t_val, Int_val, Int_val, Val_cairo_surface_t)
@@ -931,6 +1025,12 @@ ML_5(cairo_ps_surface_create, FILE_val, Double_val, Double_val, Double_val, Doub
 Unsupported(ml_cairo_ps_surface_create)
 #endif /* CAIRO_HAS_PS_SURFACE */
 
+#ifdef CAIRO_HAS_PNG_SURFACE
+ML_4(cairo_png_surface_create, FILE_val, cairo_format_t_val, Double_val, Double_val, Val_cairo_surface_t)
+#else
+Unsupported(ml_cairo_png_surface_create)
+#endif /* CAIRO_HAS_PNG_SURFACE */
+
 ML_0(cairo_matrix_create, Val_cairo_matrix_t)
 ML_1(cairo_matrix_destroy, cairo_matrix_t_val, Unit)
 ML_2(cairo_matrix_copy, cairo_matrix_t_val, cairo_matrix_t_val, Val_cairo_status_t)
@@ -1012,19 +1112,37 @@ ml_cairo_surface_finalise(value s)
   return Val_unit;
 }
 
-#ifdef CAIRO_HAS_PNG_SURFACE
-CAMLprim value
-ml_cairo_set_target_png(value v_cr, value v_file, value v_format,
-			value v_width, value v_height)
+ML_1 (cairo_pattern_create_for_surface, cairo_surface_t_val, Val_cairo_pattern_t)
+ML_4 (cairo_pattern_create_linear, Double_val, Double_val, Double_val, Double_val, Val_cairo_pattern_t)
+ML_6 (cairo_pattern_create_radial, Double_val, Double_val, Double_val, Double_val, Double_val, Double_val, Val_cairo_pattern_t)
+ML_bc6 (cairo_pattern_create_radial)
+ML_6 (cairo_pattern_add_color_stop, cairo_pattern_t_val, Double_val, Double_val, Double_val, Double_val, Double_val, Val_cairo_status_t)
+ML_bc6 (cairo_pattern_add_color_stop)
+ML_2(cairo_pattern_set_matrix, cairo_pattern_t_val, cairo_matrix_t_val, Val_cairo_status_t)
+ML_2(cairo_pattern_get_matrix, cairo_pattern_t_val, cairo_matrix_t_val, Val_cairo_status_t)
+
+static inline cairo_extend_t
+cairo_extend_t_val(value _v)
 {
-  cairo_set_target_png(cairo_t_val(v_cr), FILE_val(v_file),
-		       cairo_format_t_val(v_format),
-		       Double_val(v_width), Double_val(v_height));
-  check_cairo_status(v_cr);
-  return Val_unit;
+  const cairo_extend_t _conv_tab[] =
+    { CAIRO_EXTEND_NONE, CAIRO_EXTEND_REPEAT, CAIRO_EXTEND_REFLECT };
+  return _conv_tab[Int_val(_v)];
 }
-ML_4(cairo_png_surface_create, FILE_val, cairo_format_t_val, Double_val, Double_val, Val_cairo_surface_t)
-#else
-Unsupported(ml_cairo_set_target_png)
-Unsupported(ml_cairo_png_surface_create)
-#endif /* CAIRO_HAS_PNG_SURFACE */
+static inline value
+Val_cairo_extend_t(cairo_extend_t _s)
+{
+  switch (_s)
+    {
+    case CAIRO_EXTEND_NONE:
+      return Val_int(0);
+    case CAIRO_EXTEND_REPEAT:
+      return Val_int(1);
+    case CAIRO_EXTEND_REFLECT:
+      return Val_int(2);
+    }
+  return 0;
+}
+ML_2 (cairo_pattern_set_extend, cairo_pattern_t_val, cairo_extend_t_val, Val_cairo_status_t)
+ML_1 (cairo_pattern_get_extend, cairo_pattern_t_val, Val_cairo_extend_t)
+ML_2 (cairo_pattern_set_filter, cairo_pattern_t_val, cairo_filter_t_val, Val_cairo_status_t)
+ML_1 (cairo_pattern_get_filter, cairo_pattern_t_val, Val_cairo_filter_t)
diff --git a/test/knockout.ml b/test/knockout.ml
index d6b0199..189ec66 100644
--- a/test/knockout.ml
+++ b/test/knockout.ml
@@ -58,7 +58,7 @@ let fill_checks c width height =
       Cairo.fill c end ;
     Cairo.restore c ;
 
-    Cairo.set_pattern c check ;
+    Cairo.set_pattern c (Cairo.pattern_create_for_surface check) ;
     rect_path c 0. 0. (float width) (float height) ;
     Cairo.fill c end ;
   Cairo.restore c