add libsvg-cairo bindings

14 files changed, 261 insertions, 17 deletions

diff --git a/ChangeLog b/ChangeLog
index d2c62ad..9f7e060 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,16 @@
+2005-03-01  Olivier Andrieu  <oliv__a@users.sourceforge.net>
+
+	* src/ml_svg_cairo.c, src/svg_cairo.ml, src/svg_cairo.mli : add
+	libsvg-cairo bindings
+
+	* test/svg2png.ml : ocaml version of svg2png
+
+	* * : configure stuff
+	
+2005-02-27  Olivier Andrieu  <oliv__a@users.sourceforge.net>
+
+	* test/Makefile, test/kapow.ml : add the kapow example program.
+	
 2005-01-26  Olivier Andrieu  <oliv__a@users.sourceforge.net>
 
 	* configure.ac: require cairo 0.3.0
diff --git a/Makefile b/Makefile
index 01cfdc8..646ccf4 100644
--- a/Makefile
+++ b/Makefile
@@ -3,7 +3,7 @@ all opt doc install clean :
 	$(MAKE) -C src $@
 
 
-VERSION = 0.3
+VERSION = 0.3.0
 DISTSRC = aclocal.m4 config.make.in configure configure.ac Makefile Makefile.rules \
           doc support/install-sh support/ocaml.m4 \
           src/*.ml src/*.mli src/*.c src/*.h src/Makefile src/.depend_c \
diff --git a/config.make.in b/config.make.in
index 7f211ba..0cf3d55 100644
--- a/config.make.in
+++ b/config.make.in
@@ -23,6 +23,9 @@ GDK_LIBS   = $(filter-out $(FILT),@GDK_LIBS@)
 GTKCAIRO_CFLAGS = @GTKCAIRO_CFLAGS@
 GTKCAIRO_LIBS   = $(filter-out $(FILT),@GTKCAIRO_LIBS@)
 
+LIBSVG_CAIRO_CFLAGS = @LIBSVG_CAIRO_CFLAGS@
+LIBSVG_CAIRO_LIBS   = @LIBSVG_CAIRO_LIBS@
+
 cobjs     = $(patsubst %.c, %.o, $(filter %.c,$(1)))
 mlintfs   = $(patsubst %.mli, %.cmi, $(filter %.mli,$(1)))
 mlobjs    = $(patsubst %.ml, %.cmo, $(filter %.ml,$(1)))
diff --git a/configure.ac b/configure.ac
index 1e9dc15..0aef7d4 100644
--- a/configure.ac
+++ b/configure.ac
@@ -31,9 +31,13 @@ else
   use_gtkcairo=no
 fi
 
+# Optional libsvg-cairo support
+PKG_CHECK_MODULES(LIBSVG_CAIRO, libsvg-cairo, use_libsvg_cairo=yes, use_libsvg_cairo=no)
+
 echo
-echo "  GTK+     support: $use_gtk"
-echo "  GTKCairo support: $use_gtkcairo"
+echo "  GTK+         support: $use_gtk"
+echo "  GTKCairo     support: $use_gtkcairo"
+echo "  libsvg-cairo support: $use_libsvg_cairo"
 echo
 
 AC_OUTPUT(config.make)
diff --git a/src/Makefile b/src/Makefile
index de3539a..553a5c7 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -10,7 +10,9 @@ ifdef GTKCAIRO_CFLAGS
 TARGETS += gtkcairo
 endif
 endif
-
+ifdef LIBSVG_CAIRO_CFLAGS
+TARGETS += svgcairo
+endif
 all : $(TARGETS) $(if $(OCAMLOPT),opt)
 opt : $(addsuffix .opt,$(TARGETS))
 
@@ -20,6 +22,8 @@ lablgtk     : cairo_lablgtk.cma  libmlcairo_lablgtk.a
 lablgtk.opt : cairo_lablgtk.cmxa dllmlcairo_lablgtk.so
 gtkcairo     : gtkcairo.cma  libmlgtkcairo.a
 gtkcairo.opt : gtkcairo.cmxa dllmlgtkcairo.so
+svgcairo     : svg_cairo.cma libmlsvgcairo.a
+svgcairo.opt : svg_cairo.cmxa dllmlsvgcairo.so
 
 cairo_SRC = cairo_channel.mli cairo_channel.ml cairo.mli cairo.ml \
             cairo_bigarray.mli cairo_bigarray.ml \
@@ -54,9 +58,19 @@ gtkcairo.cmxa : $(call mloptobjs,$(gtkcairo_SRC))
 libmlgtkcairo.a dllmlgtkcairo.so : $(call cobjs,$(gtkcairo_SRC))
 	$(OCAMLMKLIB) -o gtkcairo -oc mlgtkcairo $^ $(GTKCAIRO_LIBS)
 
+svgcairo_SRC = svg_cairo.mli svg_cairo.ml ml_svg_cairo.c
+
+svg_cairo.cma : $(call mlobjs,$(svgcairo_SRC))
+	$(OCAMLMKLIB) -o svg_cairo -oc mlsvgcairo $^ $(LIBSVG_CAIRO_LIBS)
+svg_cairo.cmxa : $(call mloptobjs,$(svgcairo_SRC))
+	$(OCAMLMKLIB) -o svg_cairo -oc mlsvgcairo $^ $(LIBSVG_CAIRO_LIBS)
+libmlsvgcairo.a dllmlsvgcairo.so : $(call cobjs,$(svgcairo_SRC))
+	$(OCAMLMKLIB) -o svg_cairo -oc mlsvgcairo $^ $(LIBSVG_CAIRO_LIBS)
+
 $(call cobjs,$(cairo_SRC))    : CPPFLAGS+=$(CAIRO_CFLAGS)
 $(call cobjs,$(lablgtk_SRC))  : CPPFLAGS+=$(GDK_CFLAGS) -I$(C_LABLGTKDIR)
 $(call cobjs,$(gtkcairo_SRC)) : CPPFLAGS+=$(GTKCAIRO_CFLAGS) -I$(C_LABLGTKDIR)
+$(call cobjs,$(svgcairo_SRC))  : CPPFLAGS+=$(LIBSVG_CAIRO_CFLAGS)
 $(call mlobjs,$(lablgtk_SRC))  : INCFLAGS=-I $(LABLGTKDIR)
 $(call mlobjs,$(gtkcairo_SRC)) : INCFLAGS=-I $(LABLGTKDIR)
 $(call mlintfs,$(lablgtk_SRC))  : INCFLAGS=-I $(LABLGTKDIR)
@@ -82,6 +96,9 @@ ifdef GTKCAIRO_CFLAGS
 DOCFILES += cairo_gtkcairo.mli
 endif
 endif
+ifdef LIBSVG_CAIRO_CFLAGS
+DOCFILES += svg_cairo.mli
+endif
 doc: $(DOCFILES:%.mli=%.cmi)
 	mkdir -p ../doc/html
 	ocamldoc -v -html -d ../doc/html -t Cairo-ocaml $(if $(LABLGTKDIR),-I $(LABLGTKDIR)) $(DOCFILES) 
diff --git a/src/ml_cairo.c b/src/ml_cairo.c
index 41157a5..b5b106f 100644
--- a/src/ml_cairo.c
+++ b/src/ml_cairo.c
@@ -49,11 +49,11 @@ Val_cairo_t (cairo_t * p)
   return ret;
 }
 
-Make_Val_final_pointer(cairo_surface_t, Ignore, cairo_surface_destroy, 20)
+Make_Val_final_pointer(cairo_surface_t, Id, cairo_surface_destroy, 20)
 
-Make_Val_final_pointer(cairo_matrix_t, Ignore, cairo_matrix_destroy, 100)
+Make_Val_final_pointer(cairo_matrix_t, Id, cairo_matrix_destroy, 100)
 
-Make_Val_final_pointer(cairo_pattern_t, Ignore, cairo_pattern_destroy, 20)
+Make_Val_final_pointer(cairo_pattern_t, Id, cairo_pattern_destroy, 20)
 #define cairo_pattern_t_val(v) ((cairo_pattern_t *)Pointer_val(v))
 
 CAMLprim value
@@ -607,7 +607,7 @@ ml_cairo_clip (value v_cr)
   return Val_unit;
 }
 
-Make_Val_final_pointer(cairo_font_t, Ignore, cairo_font_destroy, 20)
+Make_Val_final_pointer(cairo_font_t, Id, cairo_font_destroy, 20)
 
 static void
 cairo_glyph_t_val (cairo_glyph_t * _s, value _v)
diff --git a/src/ml_cairo_ft.c b/src/ml_cairo_ft.c
index 3bc164e..df8ef22 100644
--- a/src/ml_cairo_ft.c
+++ b/src/ml_cairo_ft.c
@@ -73,7 +73,7 @@ ml_FT_Done_Face (value face)
 }
 
 /* minimal Fontconfig interface */
-Make_Val_final_pointer (FcPattern, Ignore, FcPatternDestroy, 10)
+Make_Val_final_pointer (FcPattern, Id, FcPatternDestroy, 10)
 #define FcPattern_val(v) (FcPattern *)Pointer_val(v)
 
 ML_1 (FcNameParse, String_val, Val_FcPattern)
diff --git a/src/ml_cairo_wrappers.h b/src/ml_cairo_wrappers.h
index 05a7d03..78bfb33 100644
--- a/src/ml_cairo_wrappers.h
+++ b/src/ml_cairo_wrappers.h
@@ -13,7 +13,8 @@ static struct custom_operations ml_custom_##type = \
 value Val_##type (type *p) \
 { value ret; if (!p) report_null_pointer; \
   ret = alloc_custom (&ml_custom_##type, sizeof(value), adv, 1000); \
-  Field(ret,1) = (value) p; init(p); return ret; }
+  p = init(p); \
+  Field(ret,1) = Val_bp (p); return ret; }
 
 static inline value Val_ptr(void *p)
 {
@@ -29,9 +30,11 @@ static inline value Val_ptr(void *p)
 #define Double_array_length(v) (Wosize_val(v) / Double_wosize)
 
 #define Option_val(v,conv,def) (Is_long(v) ? def : conv(Field((v),0)))
+#define StringOption_val(v) Option_val(v, String_val, NULL)
 
 #define Ignore(x)
 #define Unit(x) ((x), Val_unit)
+#define Id(x) (x)
 
 #define Unsupported(fun) \
 CAMLprim value fun() { failwith("Unsupported backend"); return Val_unit; }
diff --git a/src/ml_svg_cairo.c b/src/ml_svg_cairo.c
new file mode 100644
index 0000000..0dc66ec
--- /dev/null
+++ b/src/ml_svg_cairo.c
@@ -0,0 +1,74 @@
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/fail.h>
+#include <caml/callback.h>
+#include <caml/custom.h>
+
+#include <svg-cairo.h>
+
+#define report_null_pointer failwith("null pointer")
+#include "ml_cairo_wrappers.h"
+#include "ml_cairo.h"
+
+static value
+ml_svg_cairo_status (svg_cairo_status_t s)
+{
+  static value *exn;
+  if (s == SVG_CAIRO_STATUS_SUCCESS)
+    return Val_unit;
+  if (exn == NULL)
+    {
+      exn = caml_named_value ("svg_cairo_status_exn");
+      if (exn == NULL)
+	failwith ("Svg_cairo exception not registered");
+    }
+  raise_with_arg (*exn, Val_int (s - 1));
+}
+
+Make_Val_final_pointer (svg_cairo_t, Id, svg_cairo_destroy, 100)
+#define svg_cairo_t_val(v) (svg_cairo_t *)Pointer_val(v)
+
+CAMLprim value
+ml_svg_cairo_create (value unit)
+{
+  svg_cairo_status_t status;
+  svg_cairo_t *s;
+  status = svg_cairo_create (&s);
+  ml_svg_cairo_status (status);
+  return Val_svg_cairo_t (s);
+}
+
+ML_2 (svg_cairo_parse, svg_cairo_t_val, String_val, ml_svg_cairo_status)
+
+CAMLprim value
+ml_svg_cairo_parse_buffer (value s, value b)
+{
+  return ml_svg_cairo_status (svg_cairo_parse_buffer (svg_cairo_t_val (s),
+						      String_val (b),
+						      string_length (b)));
+}
+
+ML_1 (svg_cairo_parse_chunk_begin, svg_cairo_t_val, ml_svg_cairo_status)
+CAMLprim value
+ml_svg_cairo_parse_chunk (value s, value b)
+{
+  return ml_svg_cairo_status (svg_cairo_parse_chunk (svg_cairo_t_val (s),
+						     String_val (b),
+						     string_length (b)));
+}
+ML_1 (svg_cairo_parse_chunk_end, svg_cairo_t_val, ml_svg_cairo_status)
+
+ML_2 (svg_cairo_render, svg_cairo_t_val, cairo_t_val, ml_svg_cairo_status)
+ML_3 (svg_cairo_set_viewport_dimension, svg_cairo_t_val, Unsigned_int_val, Unsigned_int_val, ml_svg_cairo_status)
+
+CAMLprim value
+ml_svg_cairo_get_size (value s)
+{
+  int w, h;
+  value r;
+  svg_cairo_get_size (svg_cairo_t_val (s), &w, &h);
+  r = alloc_small (2, 0);
+  Field (r, 0) = Val_int (w);
+  Field (r, 1) = Val_int (h);
+  return r;
+}
diff --git a/src/svg_cairo.ml b/src/svg_cairo.ml
new file mode 100644
index 0000000..7f3ed52
--- /dev/null
+++ b/src/svg_cairo.ml
@@ -0,0 +1,26 @@
+type status =
+    NO_MEMORY
+  | IO_ERROR
+  | FILE_NOT_FOUND
+  | INVALID_VALUE
+  | INVALID_CALL
+  | PARSE_ERROR
+exception Error of status
+let init = Callback.register "svg_cairo_status_exn" (Error NO_MEMORY)
+
+type t
+
+external create  : unit -> t = "ml_svg_cairo_create"
+
+external parse        : t -> string -> unit = "ml_svg_cairo_parse"
+external parse_string : t -> string -> unit = "ml_svg_cairo_parse_buffer"
+
+external parse_chunk_begin : t -> unit = "ml_svg_cairo_parse_chunk_begin"
+external parse_chunk       : t -> string -> unit = "ml_svg_cairo_parse_chunk"
+external parse_chunk_end   : t -> unit = "ml_svg_cairo_parse_chunk_end"
+
+external render : t -> Cairo.t -> unit = "ml_svg_cairo_render"
+
+external set_viewport_dimenstion : t -> int -> int -> unit = "ml_svg_cairo_set_viewport_dimension"
+
+external get_size  : t -> int * int = "ml_svg_cairo_get_size"
diff --git a/src/svg_cairo.mli b/src/svg_cairo.mli
new file mode 100644
index 0000000..adaeb9d
--- /dev/null
+++ b/src/svg_cairo.mli
@@ -0,0 +1,26 @@
+type status =
+    NO_MEMORY
+  | IO_ERROR
+  | FILE_NOT_FOUND
+  | INVALID_VALUE
+  | INVALID_CALL
+  | PARSE_ERROR
+exception Error of status
+val init : unit
+
+type t
+
+external create  : unit -> t = "ml_svg_cairo_create"
+
+external parse        : t -> string -> unit = "ml_svg_cairo_parse"
+external parse_string : t -> string -> unit = "ml_svg_cairo_parse_buffer"
+
+external parse_chunk_begin : t -> unit = "ml_svg_cairo_parse_chunk_begin"
+external parse_chunk       : t -> string -> unit = "ml_svg_cairo_parse_chunk"
+external parse_chunk_end   : t -> unit = "ml_svg_cairo_parse_chunk_end"
+
+external render : t -> Cairo.t -> unit = "ml_svg_cairo_render"
+
+external set_viewport_dimenstion : t -> int -> int -> unit = "ml_svg_cairo_set_viewport_dimension"
+
+external get_size  : t -> int * int = "ml_svg_cairo_get_size"
diff --git a/test/Makefile b/test/Makefile
index 7ef930e..1ab9053 100644
--- a/test/Makefile
+++ b/test/Makefile
@@ -8,9 +8,15 @@ TARGETS += text demo spline basket knockout font
 # TARGETS += cube
 # endif
 endif
+ifdef LIBSVG_CAIRO_CFLAGS
+TARGETS += svg2png 
+endif
 
 all : $(TARGETS)
 
+svg2png : svg2png.ml
+	$(OCAMLOPT) -o $@ -I ../src cairo.cmxa svg_cairo.cmxa $^
+
 kapow : kapow.ml
 	$(OCAMLOPT) -o $@ -I ../src cairo.cmxa $^
 
diff --git a/test/font.ml b/test/font.ml
index 3d3c192..63ef60f 100644
--- a/test/font.ml
+++ b/test/font.ml
@@ -1,10 +1,4 @@
 
-let out_file name =
-  let oc = open_out name in
-  let channel = Cairo_channel.of_out_channel oc in
-  close_out oc ;
-  channel
-
 let pi = 4. *. atan 1.
 
 let main font_arg =
@@ -22,7 +16,7 @@ let main font_arg =
   in
 
   let cr = Cairo.create () in
-  let file = out_file "test_font.png" in
+  let file = Cairo_channel.open_out "test_font.png" in
   Cairo.set_target_png ~cr ~file Cairo.FORMAT_ARGB32 ~width:200 ~height:200 ;
 
   Cairo.set_font ~cr ~font ;
diff --git a/test/svg2png.ml b/test/svg2png.ml
new file mode 100644
index 0000000..9008adb
--- /dev/null
+++ b/test/svg2png.ml
@@ -0,0 +1,78 @@
+
+type args = {
+    svg_file : string ;
+    png_file : string ;
+    scale    : float ;
+    width    : int ;
+    height   : int ;
+  }
+
+let parse_args () =
+  let svg_file = ref "" in
+  let png_file = ref "" in
+  let scale = ref 1. in
+  let width = ref (-1) in
+  let height = ref (-1) in
+  let spec = [
+    "-s", Arg.Set_float scale, "scale";
+    "-w", Arg.Set_int width, "width";
+    "-h", Arg.Set_int height, "height" ] in
+  let msg = 
+    Printf.sprintf "usage: %s [options] <svg_file> [png_file]"
+      (Filename.basename Sys.executable_name) in
+  Arg.parse 
+    spec
+    (fun arg -> 
+      if !svg_file = "" then svg_file := arg else
+      if !png_file = "" then png_file := arg else
+      ())
+    msg ;
+  if !svg_file = "" then begin
+    Arg.usage spec msg ;
+    exit 1
+  end ;
+  if !png_file = "" then
+    png_file :=
+      begin
+	if Filename.check_suffix !svg_file ".svg"
+	then Filename.chop_suffix !svg_file ".svg"
+	else !svg_file 
+      end ^ ".png" ;
+  { svg_file = !svg_file ; png_file = !png_file ;
+    scale = !scale ; width = !width ; height = !height }
+
+let render_to_png args =
+  let cr = Cairo.create () in
+  let svgc = Svg_cairo.create () in
+  Svg_cairo.parse svgc args.svg_file ;
+  let svg_width, svg_height = Svg_cairo.get_size svgc in
+  let scale, width, height = 
+    if args.width < 0 && args.height < 0 then
+      let width  = float svg_width  *. args.scale +. 0.5 in
+      let height = float svg_height *. args.scale +. 0.5 in
+      args.scale, int_of_float width, int_of_float height 
+    else if args.width < 0 then
+      let scale = float args.height /. float svg_height in
+      let width = float svg_width *. scale +. 0.5 in
+      scale, int_of_float width, args.height
+    else if args.height < 0 then
+      let scale = float args.width /. float svg_width in
+      let height = float svg_height *. scale +. 0.5 in
+      scale, args.width, int_of_float height
+    else 
+      let scale = min (float args.height /. float svg_height) (float args.width /. float svg_width) in
+      let dx = (float args.width  -. (float svg_width  *. scale +. 0.5)) /. 2. in
+      let dy = (float args.height -. (float svg_height *. scale +. 0.5)) /. 2. in
+      Cairo.translate cr dx dy ;
+      scale, args.width, args.height in
+  
+  Cairo.scale cr scale scale ;
+  let chan = Cairo_channel.open_out args.png_file in
+  Cairo.set_target_png cr chan Cairo.FORMAT_ARGB32 width height ;
+  Cairo.set_rgb_color cr 1. 1. 1. ;
+  Svg_cairo.render svgc cr ;
+  Cairo.show_page cr ;
+  Cairo_channel.close chan
+
+let _ = 
+  render_to_png (parse_args ())