Add SVG backend support

* src/cairo_svg.mli, src/cairo_svg.mli, src/ml_cairo_svg.c: support
  for the SVG backend.
* test/basket.ml: test SVG output.

6 files changed, 141 insertions, 21 deletions

diff --git a/ChangeLog b/ChangeLog
index fa59f49..827ee5a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2006-02-09  Olivier Andrieu  <oliv__a@users.sourceforge.net>
+
+	* src/cairo_svg.mli, src/cairo_svg.mli, src/ml_cairo_svg.c:
+	support for the SVG backend.
+
+	* test/basket.ml: test SVG output.
+
 2005-12-13  Olivier Andrieu  <oliv__a@users.sourceforge.net>
 
 	* src/cairo_ps.mli, src/cairo_ps.mli, src/ml_cairo_ps.c: add
diff --git a/src/Makefile b/src/Makefile
index 1565355..24bf418 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -27,12 +27,13 @@ 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_svg.mli cairo_svg.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_ft.c \
-	    ml_cairo_png.c ml_cairo_pdf.c ml_cairo_ps.c
+	    ml_cairo_png.c ml_cairo_pdf.c ml_cairo_ps.c ml_cairo_svg.c
 
 cairo.cma : $(call mlobjs,$(cairo_SRC))
 	$(OCAMLMKLIB) -o cairo -oc mlcairo $^ $(CAIRO_LIBS)
diff --git a/src/cairo_svg.ml b/src/cairo_svg.ml
new file mode 100644
index 0000000..9f665f4
--- /dev/null
+++ b/src/cairo_svg.ml
@@ -0,0 +1,31 @@
+(**************************************************************************)
+(*  cairo-ocaml -- Objective Caml bindings for Cairo                      *)
+(*  Copyright © 2004-2005 Olivier Andrieu                                 *)
+(*                                                                        *)
+(*  This code is free software and is licensed under the terms of the     *)
+(*  GNU Lesser General Public License version 2.1 (the "LGPL").           *)
+(**************************************************************************)
+
+type surface = [`Any|`SVG] Cairo.surface
+
+external surface_create_for_stream_unsafe : 
+  (string -> int -> unit) ->
+  width_in_points:float -> 
+  height_in_points:float -> surface = "ml_cairo_svg_surface_create_for_stream_unsafe"
+
+let unsafe_output_string oc s n =
+  for i = 0 to n - 1 do
+    output_char oc (String.unsafe_get s i)
+  done
+
+let surface_create_for_channel oc ~width_in_points ~height_in_points =
+  surface_create_for_stream_unsafe
+    (unsafe_output_string oc) ~width_in_points ~height_in_points
+
+external surface_create_for_stream :
+  (string -> unit) ->
+  width_in_points:float -> 
+  height_in_points:float -> surface = "ml_cairo_svg_surface_create_for_stream"
+
+external set_dpi :
+  [> `SVG] Cairo.surface -> x_dpi:float -> y_dpi:float -> unit = "ml_cairo_svg_surface_set_dpi"
diff --git a/src/cairo_svg.mli b/src/cairo_svg.mli
new file mode 100644
index 0000000..42d1977
--- /dev/null
+++ b/src/cairo_svg.mli
@@ -0,0 +1,24 @@
+(**************************************************************************)
+(*  cairo-ocaml -- Objective Caml bindings for Cairo                      *)
+(*  Copyright © 2004-2005 Olivier Andrieu                                 *)
+(*                                                                        *)
+(*  This code is free software and is licensed under the terms of the     *)
+(*  GNU Lesser General Public License version 2.1 (the "LGPL").           *)
+(**************************************************************************)
+
+(** SVG backend *)
+
+type surface = [`Any|`SVG] Cairo.surface
+
+val surface_create_for_channel : 
+  out_channel -> 
+  width_in_points:float -> 
+  height_in_points:float -> surface
+
+external surface_create_for_stream :
+  (string -> unit) ->
+  width_in_points:float -> 
+  height_in_points:float -> surface = "ml_cairo_svg_surface_create_for_stream"
+
+external set_dpi :
+  [> `SVG] Cairo.surface -> x_dpi:float -> y_dpi:float -> unit = "ml_cairo_svg_surface_set_dpi"
diff --git a/src/ml_cairo_svg.c b/src/ml_cairo_svg.c
new file mode 100644
index 0000000..2f21b1d
--- /dev/null
+++ b/src/ml_cairo_svg.c
@@ -0,0 +1,50 @@
+/**************************************************************************/
+/*  cairo-ocaml -- Objective Caml bindings for Cairo                      */
+/*  Copyright © 2004-2005 Olivier Andrieu                                 */
+/*                                                                        */
+/*  This code is free software and is licensed under the terms of the     */
+/*  GNU Lesser General Public License version 2.1 (the "LGPL").           */
+/**************************************************************************/
+
+#include "ml_cairo.h"
+
+#if CAIRO_HAS_SVG_SURFACE
+# include <cairo-svg.h>
+
+static value
+_ml_cairo_svg_surface_create_for_stream (value f, value w, value h, cairo_bool_t unsafe)
+{
+  CAMLparam3(f, w, h);
+  value *c;
+  cairo_surface_t *surf;
+
+  c = ml_cairo_make_closure (f);
+  surf = cairo_svg_surface_create_for_stream (unsafe ? ml_cairo_unsafe_write_func : ml_cairo_write_func,
+					      c, Double_val (w), Double_val (h));
+
+  ml_cairo_surface_set_stream_data (surf, c);
+
+  CAMLreturn (Val_cairo_surface_t (surf));
+}
+
+CAMLprim value
+ml_cairo_svg_surface_create_for_stream_unsafe (value f, value w, value h)
+{
+  return _ml_cairo_svg_surface_create_for_stream (f, w, h, 1);
+}
+
+CAMLprim value
+ml_cairo_svg_surface_create_for_stream (value f, value w, value h)
+{
+  return _ml_cairo_svg_surface_create_for_stream (f, w, h, 0);
+}
+
+wML_3(cairo_svg_surface_set_dpi, cairo_surface_t_val, Double_val, Double_val, Unit)
+
+#else
+
+Cairo_Unsupported(cairo_svg_surface_create_for_stream_unsafe,	"SVG backend not supported");
+Cairo_Unsupported(cairo_svg_surface_create_for_stream, 		"SVG backend not supported");
+Cairo_Unsupported(cairo_svg_surface_set_dpi,			"SVG backend not supported");
+
+#endif
diff --git a/test/basket.ml b/test/basket.ml
index a46f5ec..6191cbd 100644
--- a/test/basket.ml
+++ b/test/basket.ml
@@ -56,29 +56,36 @@ let do_file_out fname f =
 let x_inches = 8.
 let y_inches = 3.
 
+
+let file_backend ?(verbose=false) ~backend_name ~filename surface_create =
+  prerr_endline backend_name ;
+  do_file_out filename
+    (fun oc ->
+      let width_in_points  = x_inches *. 72. in
+      let height_in_points = y_inches *. 72. in
+      let s = surface_create oc ~width_in_points ~height_in_points in
+      let c = Cairo.create s in
+      draw ~print:verbose c ;
+      Cairo.show_page c ;
+      Cairo.surface_finish s)
+
 let main () =
 
-  begin
-    prerr_endline "PS" ;
-    do_file_out "basket.ps"
-      (fun oc ->
-	let s = Cairo_ps.surface_create_for_channel oc (x_inches *. 72.) (y_inches *. 72.) in
-	let c = Cairo.create s in
-	draw ~print:true c ;
-	Cairo.show_page c ;
-	Cairo.surface_finish s)
-  end ;
+  file_backend
+    ~verbose:true
+    ~backend_name:"PS"
+    ~filename:"basket.ps"
+    Cairo_ps.surface_create_for_channel ;
 
-  begin
-    prerr_endline "PDF" ;
-    do_file_out "basket.pdf"
-      (fun oc ->
-	let s = Cairo_pdf.surface_create_for_channel oc (x_inches *. 72.) (y_inches *. 72.) in
-	let c = Cairo.create s in
-	draw c ;
-	Cairo.show_page c ;
-	Cairo.surface_finish s)
-  end ;
+  file_backend
+    ~backend_name:"PDF"
+    ~filename:"basket.pdf"
+    Cairo_pdf.surface_create_for_channel ;
+
+  file_backend
+    ~backend_name:"SVG"
+    ~filename:"basket.svg"
+    Cairo_svg.surface_create_for_channel ;
 
   begin
     prerr_endline "Bigarray, PPM and PNG (ARGB32) " ;