wrap cairo_current_path and cairo_current_path_flat

8 files changed, 55 insertions, 10 deletions

diff --git a/ChangeLog b/ChangeLog
index 99a695d..dde0aa6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -10,6 +10,10 @@
 
 	* test/Makefile, test/demo.ml: added a translation of cairo-demo.c
 
+	* src/cairo.ml, src/cairo.mli, src/ml_cairo.c, src/ml_cairo.h,
+	src/ml_cairo_lablgtk.c, src/Makefile, test/basket.ml: added
+	support for cairo_current_path and cairo_current_path_flat
+
 2003-12-17 02:15  Olivier Andrieu <oliv__a@users.sourceforge.net>
 
 	* configure.ac, src/cairo.ml, src/cairo.mli, src/ml_cairo.c,
diff --git a/src/Makefile b/src/Makefile
index 006046c..20019e5 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -25,7 +25,7 @@ cairo_SRC = cairo_channel.mli cairo.mli cairo.ml \
             cairo_bigarray.mli cairo_bigarray.ml \
             ocairo.mli ocairo.ml \
 	    ml_cairo_status.c ml_cairo_channel.c \
-            ml_cairo.c ml_cairo_bigarr.c
+            ml_cairo.c ml_cairo_bigarr.c ml_cairo_path.c
 
 cairo.cma : $(call mlobjs,$(cairo_SRC))
 	$(OCAMLMKLIB) -o cairo -oc mlcairo $^ $(CAIRO_LIBS)
diff --git a/src/cairo.ml b/src/cairo.ml
index 450baf7..78eb92e 100644
--- a/src/cairo.ml
+++ b/src/cairo.ml
@@ -243,3 +243,13 @@ external matrix_transform_point :
   matrix:matrix -> point -> unit = "ml_cairo_matrix_transform_point"
 external finalise_target : cr:t -> unit = "ml_cairo_finalise_target"
 external surface_finalise : surface -> unit = "ml_cairo_surface_finalise"
+
+type flat_path = [
+  | `MOVE_TO of point
+  | `LINE_TO of point
+  | `CLOSE ]
+type basic_path = [
+  | flat_path
+  | `CURVE_TO of point * point * point ]
+external fold_current_path      : t -> ('a -> [> basic_path] -> 'a) -> 'a -> 'a = "ml_cairo_current_path"
+external fold_current_path_flat : t -> ('a -> [> flat_path] -> 'a) -> 'a -> 'a  = "ml_cairo_current_path_flat"
diff --git a/src/cairo.mli b/src/cairo.mli
index d07dc2f..8624cda 100644
--- a/src/cairo.mli
+++ b/src/cairo.mli
@@ -146,6 +146,16 @@ 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"
 
+type flat_path = [
+  | `MOVE_TO of point
+  | `LINE_TO of point
+  | `CLOSE ]
+type basic_path = [
+  | flat_path
+  | `CURVE_TO of point * point * point ]
+external fold_current_path      : t -> ('a -> [> basic_path] -> 'a) -> 'a -> 'a = "ml_cairo_current_path"
+external fold_current_path_flat : t -> ('a -> [> flat_path] -> 'a) -> 'a -> 'a  = "ml_cairo_current_path_flat"
+
 (** {3 Misc stuff I don't know how to categorize} *)
 
 external show_surface :
diff --git a/src/ml_cairo.c b/src/ml_cairo.c
index e4c13f5..0a5575f 100644
--- a/src/ml_cairo.c
+++ b/src/ml_cairo.c
@@ -12,7 +12,7 @@
 #include "ml_cairo.h"
 
 Make_Val_final_pointer(cairo_t, Ignore, cairo_destroy, 20)
-#define cairo_t_val(v) ((cairo_t *)Pointer_val(v))
+
 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)
diff --git a/src/ml_cairo.h b/src/ml_cairo.h
index a61a1a2..5f99817 100644
--- a/src/ml_cairo.h
+++ b/src/ml_cairo.h
@@ -1,3 +1,5 @@
+#define cairo_t_val(v) ((cairo_t *)Pointer_val(v))
+
 static inline cairo_format_t
 cairo_format_t_val(value _v)
 {
diff --git a/src/ml_cairo_lablgtk.c b/src/ml_cairo_lablgtk.c
index 08c9dfa..b4aebbf 100644
--- a/src/ml_cairo_lablgtk.c
+++ b/src/ml_cairo_lablgtk.c
@@ -14,8 +14,6 @@
 #include "ml_cairo.h"
 #include "ml_cairo_status.h"
 
-#define cairo_t_val(v)  ((cairo_t *) Field((v), 1))
-
 CAMLprim value
 cairo_lablgtk_of_pixbuf(value pb)
 {
diff --git a/test/basket.ml b/test/basket.ml
index c7e3aa0..0001b07 100644
--- a/test/basket.ml
+++ b/test/basket.ml
@@ -2,21 +2,42 @@
 let _ =
   Cairo.init
 
-let draw c =
+let print_path_elem = function
+  | `MOVE_TO { Cairo.x = x ; Cairo.y = y } ->
+      Format.printf "@ move_to (%f, %f)" x y
+  | `LINE_TO { Cairo.x = x ; Cairo.y = y } ->
+      Format.printf "@ line_to (%f, %f)" x y
+  | `CURVE_TO ({ Cairo.x = x1 ; Cairo.y = y1 },
+	       { Cairo.x = x2 ; Cairo.y = y2 },
+	       { Cairo.x = x3 ; Cairo.y = y3 }) ->
+      Format.printf "@ curve_to (%f, %f, %f, %f, %f, %f)" x1 y1 x2 y2 x3 y3
+  | `CLOSE ->
+      Format.printf "@ close\n"
+let print_path c =
+  Format.printf "@[<v 2>current_path:" ;
+  let nb = Cairo.fold_current_path c
+      (fun nb el -> print_path_elem el ; nb+1) 0 in
+  Format.printf "@]%d elements@." nb
+
+let draw ?(print=false) c =
   Cairo.move_to c 10. 10. ;
   Cairo.line_to c 510. 10. ;
   Cairo.curve_to c 410. 200. 110. 200. 10. 10. ;
   Cairo.close_path c ;
   
-  Cairo.save c ;
-  Cairo.set_rgb_color c 0.8 0.1 0.1 ;
-  Cairo.fill c ;
+  if print then print_path c ;
+  
+  Cairo.save c ; begin
+    Cairo.set_rgb_color c 0.8 0.1 0.1 ;
+    Cairo.fill c end ;
   Cairo.restore c ;
 
   Cairo.set_line_width c 6. ;
   Cairo.set_rgb_color c 0. 0. 0. ;
   Cairo.stroke c
 
+
+
 let width = 520.
 let height = 170.
 let x_inches = width /. 96.
@@ -33,9 +54,9 @@ let main =
     let file = Cairo_channel.of_out_channel oc in
     close_out oc ;
     Cairo.set_target_ps c file x_inches y_inches x_ppi y_ppi ;
-    draw c ;
+    draw ~print:true c ;
     Cairo.show_page c ;
-    Cairo.finalise_target_ps c ;
+    Cairo.finalise_target c ;
     Cairo_channel.close file
   end ;