various small fixes

13 files changed, 170 insertions, 33 deletions

diff --git a/ChangeLog b/ChangeLog
index 2ed47ea..99a695d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,15 @@
+2004-02-22  Olivier Andrieu <oliv__a@users.sourceforge.net>
+
+	* Makefile, src/cairo.ml, src/cairo.mli, src/ocairo.ml,
+	src/ocairo.mli, src/ml_cairo.c,	src/ml_cairo_bigarr.c,
+	src/ml_cairo_channel.c, src/ml_cairo_wrappers.h:
+		* make the code safer for exotic archs (WIN32,
+		ARCH_ALIGN_DOUBLE)
+
+		* rename ps_finalise to finalise
+
+	* test/Makefile, test/demo.ml: added a translation of cairo-demo.c
+
 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/Makefile b/Makefile
index 52a7e1e..fbe7978 100644
--- a/Makefile
+++ b/Makefile
@@ -5,7 +5,7 @@ all opt doc install clean :
 
 VERSION = 0.2
 DISTSRC = aclocal.m4 config.make.in configure configure.ac Makefile Makefile.rules \
-          doc support/install-sh support/install-sh support/ocaml.m4 \
+          doc support/install-sh support/ocaml.m4 \
           src/*.ml src/*.mli src/*.c src/*.h src/Makefile src/.depend_c \
           test/Makefile test/*.ml
 dist : doc
diff --git a/src/Makefile b/src/Makefile
index 1190e8b..006046c 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -83,7 +83,7 @@ endif
 endif
 doc: $(DOCFILES:%.mli=%.cmi)
 	mkdir -p ../doc/html
-	ocamldoc -v -html -d ../doc/html $(if $(LABLGTKDIR),-I $(LABLGTKDIR)) $(DOCFILES) 
+	ocamldoc -v -html -d ../doc/html -t Cairo-ocaml $(if $(LABLGTKDIR),-I $(LABLGTKDIR)) $(DOCFILES) 
 
 clean :
 	rm -f *.cm* *.o *.a *.so
diff --git a/src/cairo.ml b/src/cairo.ml
index 0ee879f..450baf7 100644
--- a/src/cairo.ml
+++ b/src/cairo.ml
@@ -241,5 +241,5 @@ external matrix_transform_distance :
   matrix:matrix -> point -> unit = "ml_cairo_matrix_transform_distance"
 external matrix_transform_point :
   matrix:matrix -> point -> unit = "ml_cairo_matrix_transform_point"
-external finalise_target_ps : cr:t -> unit = "ml_cairo_finalise_target_ps"
-external ps_surface_finalise : surface -> unit = "ml_cairo_ps_surface_finalise"
+external finalise_target : cr:t -> unit = "ml_cairo_finalise_target"
+external surface_finalise : surface -> unit = "ml_cairo_surface_finalise"
diff --git a/src/cairo.mli b/src/cairo.mli
index 0a375a4..d07dc2f 100644
--- a/src/cairo.mli
+++ b/src/cairo.mli
@@ -40,7 +40,7 @@ external set_target_ps :
   height_inches:float ->
   x_pixels_per_inch:float -> y_pixels_per_inch:float -> unit
   = "ml_cairo_set_target_ps_bc" "ml_cairo_set_target_ps"
-external finalise_target_ps : cr:t -> unit = "ml_cairo_finalise_target_ps"
+external finalise_target : cr:t -> unit = "ml_cairo_finalise_target"
 
 (** {4 Renderer state} *)
 
@@ -244,6 +244,7 @@ type filter =
   | FILTER_BILINEAR
 external surface_set_filter : surface:surface -> filter:filter -> unit
   = "ml_cairo_surface_set_filter"
+external surface_finalise : surface -> unit = "ml_cairo_surface_finalise"
 
 (** {4 Image surface} *)
 
@@ -261,7 +262,6 @@ external ps_surface_create :
   height_inches:float ->
   x_pixels_per_inch:float -> y_pixels_per_inch:float -> surface
   = "ml_cairo_ps_surface_create"
-external ps_surface_finalise : surface -> unit = "ml_cairo_ps_surface_finalise"
 
 (** {3 Matrix API} *)
 
@@ -290,7 +290,7 @@ external matrix_transform_distance : matrix:matrix -> point -> unit
 external matrix_transform_point : matrix:matrix -> point -> unit
   = "ml_cairo_matrix_transform_point"
 
-(** {4 Font API}
+(** {3 Font API}
 
    Mostly unusable ATM. It needs other libraries (freetype2/fontconfig). 
 *)
diff --git a/src/ml_cairo.c b/src/ml_cairo.c
index c68e261..e4c13f5 100644
--- a/src/ml_cairo.c
+++ b/src/ml_cairo.c
@@ -275,8 +275,18 @@ ml_cairo_set_line_join(value v_cr, value v_line_join)
 CAMLprim value
 ml_cairo_set_dash(value cr, value d, value off)
 {
+#ifndef ARCH_ALIGN_DOUBLE
   cairo_set_dash(cairo_t_val(cr), Double_array_val(d),
 		 Double_array_length(d), Double_val(off));
+#else
+  int i, ndash = Double_array_length(d);
+  double *dashes = stat_alloc(ndash * sizeof (double));
+  for (i=0; i<ndash, i++)
+    dashes[i] = Double_field(d, i);
+  cairo_set_dash(cairo_t_val(cr), dashes, ndash, Double_val(off));
+  stat_free(dashes);
+#endif
+  check_cairo_status(cr);
   return Val_unit;
 }
 
@@ -993,14 +1003,14 @@ ml_cairo_matrix_transform_point(value m, value p)
 }
 
 CAMLprim value
-ml_cairo_finalise_target_ps(value cr)
+ml_cairo_finalise_target(value cr)
 {
   cairo_set_target_surface(cairo_t_val(cr), NULL);
   return Val_unit;
 }
 
 CAMLprim value
-ml_cairo_ps_surface_finalise(value s)
+ml_cairo_surface_finalise(value s)
 {
   cairo_surface_t *surf = cairo_surface_t_val(s);
   cairo_surface_destroy(surf);
diff --git a/src/ml_cairo_bigarr.c b/src/ml_cairo_bigarr.c
index bdd77fa..5929557 100644
--- a/src/ml_cairo_bigarr.c
+++ b/src/ml_cairo_bigarr.c
@@ -6,7 +6,7 @@ unsigned long bigarray_byte_size(struct caml_bigarray *);
 CAMLprim value
 ml_bigarray_byte_size(value b)
 {
-  return Val_int(bigarray_byte_size(Bigarray_val(b)));
+  return Val_long(bigarray_byte_size(Bigarray_val(b)));
 }
 
 CAMLprim value
diff --git a/src/ml_cairo_channel.c b/src/ml_cairo_channel.c
index 2ef173a..d4cab08 100644
--- a/src/ml_cairo_channel.c
+++ b/src/ml_cairo_channel.c
@@ -13,15 +13,12 @@
 #include "caml_io.h"
 #include "ml_cairo_channel.h"
 
-CAMLprim value
-ml_FILE_of_channel(value v)
+static value ml_FILE_of_fd(int fd)
 {
-  struct channel *c = Channel(v);
   int new_fd;
   FILE *f;
 
-  flush(c);
-  new_fd = dup(c->fd);
+  new_fd = dup(fd);
   if (new_fd < 0)
     goto fail;
   f = fdopen(new_fd, "w");
@@ -34,21 +31,21 @@ fail:
 }
 
 CAMLprim value
-ml_FILE_of_file_descr(value v)
+ml_FILE_of_channel(value v)
 {
-  int new_fd;
-  FILE *f;
-
-  new_fd = dup(Int_val(v));
-  if (new_fd < 0)
-    goto fail;
-  f = fdopen(new_fd, "w");
-  if (!f)
-    goto fail;
-  return Val_ptr(f);
+  struct channel *c = Channel(v);
+  flush(c);
+  return ml_FILE_of_fd (c->fd);
+}
 
-fail:
-  raise_sys_error(copy_string(strerror(errno)));
+CAMLprim value
+ml_FILE_of_file_descr(value v)
+{
+#ifndef _WIN32
+  return ml_FILE_of_fd (Int_val(v));
+#else
+  return failwith("unsupported");
+#endif
 }
 
 CAMLprim value
diff --git a/src/ml_cairo_wrappers.h b/src/ml_cairo_wrappers.h
index d946452..ca60a27 100644
--- a/src/ml_cairo_wrappers.h
+++ b/src/ml_cairo_wrappers.h
@@ -19,7 +19,9 @@ static inline value Val_ptr(void *p)
   return v;
 }
 
+#ifndef ARCH_ALIGN_DOUBLE
 #define Double_array_val(v)    ((double *)(v))
+#endif
 #define Double_array_length(v) (Wosize_val(v) / Double_wosize)
 
 #define Ignore(x)
diff --git a/src/ocairo.ml b/src/ocairo.ml
index 280633b..9494a9c 100644
--- a/src/ocairo.ml
+++ b/src/ocairo.ml
@@ -82,7 +82,7 @@ class cairo cairo =
     method set_target_image   i = Cairo.set_target_image c i
     method set_target_ps chan w h xpi ypi =
       Cairo.set_target_ps c chan w h xpi ypi
-    method finalise_target_ps = Cairo.finalise_target_ps
+    method finalise_target = Cairo.finalise_target
 
     method current_point = Cairo.current_point c
     method set_operator o = Cairo.set_operator c o
@@ -203,7 +203,7 @@ and surface surf =
 	Cairo.surface_get_matrix s m#get_matrix ;
 	m
       method set_filter f = Cairo.surface_set_filter s f
-      method ps_finalise = Cairo.ps_surface_finalise s
+      method finalise = Cairo.surface_finalise s
     end
 
 let cairo () =
diff --git a/src/ocairo.mli b/src/ocairo.mli
index ecae737..0471b6a 100644
--- a/src/ocairo.mli
+++ b/src/ocairo.mli
@@ -85,7 +85,7 @@ class cairo :
     method default_matrix : unit
     method fill : unit
     method fill_rule : Cairo.fill_rule
-    method finalise_target_ps : cr:Cairo.t -> unit
+    method finalise_target : cr:Cairo.t -> unit
     method font_extents : Cairo.font_extents
     method get_cairo : Cairo.t
     method glyph_extents : glyph array -> text_extents
@@ -177,7 +177,7 @@ and surface :
     method set_filter : Cairo.filter -> unit
     method set_matrix : matrix -> unit
     method set_repeat : bool -> unit
-    method ps_finalise : unit
+    method finalise : unit
   end
 
 val cairo : unit -> cairo
diff --git a/test/Makefile b/test/Makefile
index ffce69a..a063762 100644
--- a/test/Makefile
+++ b/test/Makefile
@@ -2,7 +2,7 @@
 include ../config.make
 
 ifdef LABLGTKDIR
-TARGETS += text spline basket knockout oknockout
+TARGETS += text demo spline basket knockout oknockout
 ifdef GTKCAIRO_CFLAGS
 TARGETS += cube
 endif
@@ -13,6 +13,9 @@ all : $(TARGETS)
 text : text.ml
 	$(OCAMLOPT) -w s -o $@ -I ../src -I $(LABLGTKDIR) lablgtk.cmxa cairo.cmxa cairo_lablgtk.cmxa gtkInit.cmx $^
 
+demo : demo.ml
+	$(OCAMLOPT) -w s -o $@ -I ../src -I $(LABLGTKDIR) lablgtk.cmxa cairo.cmxa cairo_lablgtk.cmxa gtkInit.cmx $^
+
 cube : cube.ml
 	$(OCAMLOPT) -w s -o $@ -I ../src -I $(LABLGTKDIR) lablgtk.cmxa cairo.cmxa gtkcairo.cmxa gtkInit.cmx $^
 
diff --git a/test/demo.ml b/test/demo.ml
new file mode 100644
index 0000000..54e2ed5
--- /dev/null
+++ b/test/demo.ml
@@ -0,0 +1,113 @@
+let size = 20.
+
+let cairo_path cr = function
+  | [] -> invalid_arg "empty path"
+  | (x, y) :: t ->
+      Cairo.move_to cr x y ;
+      List.iter 
+	(fun (x, y) -> 
+	  Cairo.rel_line_to cr x y) t ;
+      Cairo.close_path cr
+
+let triangle cr =
+  cairo_path cr
+    [ size, 0. ;
+      size, (2. *. size) ;
+      ((-2.) *. size), 0. ]
+let square cr =
+  cairo_path cr
+    [ 0., 0. ;
+      (2. *. size), 0. ;
+      0., (2. *. size);
+      ((-2.) *. size), 0. ]
+let bowtie cr =
+  cairo_path cr
+    [ 0., 0. ;
+      (2. *. size), (2. *. size) ;
+      ((-2.) *. size), 0. ;
+      (2. *. size), ((-2.) *. size) ]
+let inf cr =
+  Cairo.move_to cr 0. size ;
+  Cairo.rel_curve_to cr 0. size size size (2. *. size) 0. ;
+  Cairo.rel_curve_to cr size (~-. size) (2. *. size) (~-. size) (2. *. size) 0. ;
+  Cairo.rel_curve_to cr 0. size (~-. size) size ((-2.) *. size) 0. ;
+  Cairo.rel_curve_to cr (~-. size) (~-. size) ((-2.) *. size) (~-. size) ((-2.) *. size) 0. ;
+  Cairo.close_path cr
+
+let draw_shapes cr x y fill =
+  let paint = if fill then Cairo.fill else Cairo.stroke in
+  Cairo.save cr ; begin
+    Cairo.new_path cr ;
+    Cairo.translate cr (x +. size) (y +. size) ;
+    List.iter
+      (fun draw ->
+	draw cr ; 
+	paint cr ;
+	Cairo.new_path cr ;
+	Cairo.translate cr (4. *. size) 0.)
+      [ bowtie ; square ; triangle; inf ] end ;
+  Cairo.restore cr
+
+let pi = 4. *. atan 1.
+
+let redraw (px : GDraw.pixmap) =
+  begin
+    px#set_foreground `BLACK ;
+    let width, height = px#size in
+    px#rectangle ~x:0 ~y:0 ~width ~height ~filled:true ()
+  end ;
+  let cr = Cairo.create () in
+  Cairo_lablgtk.set_target_drawable cr px#pixmap ;
+  Cairo.set_rgb_color cr 1. 1. 1. ;
+
+  Cairo.save cr ; begin 
+    Cairo.scale_font cr 20. ;
+    Cairo.move_to cr 10. 10. ;
+    Cairo.rotate cr (pi /. 2.) ;
+    Cairo.show_text cr "Hello World !" end ;
+  Cairo.restore cr ;
+  
+  Cairo.set_line_width cr (size /. 4.) ;
+  Cairo.set_tolerance cr 1. ;
+  
+  Cairo.set_line_join cr Cairo.LINE_JOIN_ROUND ;
+  Cairo.set_dash cr [| size /. 4. ; size /. 4. |] 0. ;
+  draw_shapes cr 0. 0. false ;
+  Cairo.translate cr 0. (4. *. size) ;
+
+  Cairo.set_dash cr [||] 0. ;
+  draw_shapes cr 0. 0. false ;
+  Cairo.translate cr 0. (4. *. size) ;
+
+  Cairo.set_line_join cr Cairo.LINE_JOIN_BEVEL ;
+  draw_shapes cr 0. 0. false ;
+  Cairo.translate cr 0. (4. *. size) ;
+
+  Cairo.set_line_join cr Cairo.LINE_JOIN_MITER ;
+  draw_shapes cr 0. 0. false ;
+  Cairo.translate cr 0. (4. *. size) ;
+    
+  draw_shapes cr 0. 0. true ;
+  Cairo.translate cr 0. (4. *. size) ;
+
+  Cairo.set_line_join cr Cairo.LINE_JOIN_BEVEL ;
+  draw_shapes cr 0. 0. true ;
+
+  Cairo.set_rgb_color cr 1. 0. 0. ;
+  draw_shapes cr 0. 0. false
+
+
+
+let main () = 
+  let w = GWindow.window ~title:"Cairo demo" () in
+  w#connect#destroy GMain.quit ;
+
+  let px = GDraw.pixmap ~width:400 ~height:500 ~window:w () in
+  begin try redraw px 
+  with Cairo.Error _ -> prerr_endline "Cairo is unhappy" end ;
+  let img = GMisc.pixmap px ~packing:w#add () in
+  
+  w#show () ;
+  GMain.main ()
+
+let _ = main ()