diff options
Diffstat (limited to 'src/ml_cairo.c')
-rw-r--r-- | src/ml_cairo.c | 1139 |
1 files changed, 270 insertions, 869 deletions
diff --git a/src/ml_cairo.c b/src/ml_cairo.c index 7ff7769..6b076cb 100644 --- a/src/ml_cairo.c +++ b/src/ml_cairo.c @@ -6,269 +6,50 @@ /* GNU Lesser General Public License version 2.1 (the "LGPL"). */ /**************************************************************************/ -#include <caml/mlvalues.h> -#include <caml/alloc.h> -#include <caml/memory.h> -#include <caml/fail.h> -#include <caml/custom.h> - -#include "ml_cairo_wrappers.h" - -#include <cairo.h> -/* import file-based backends */ -#ifdef CAIRO_HAS_PS_SURFACE -# include <cairo-ps.h> -#endif -#ifdef CAIRO_HAS_PDF_SURFACE -# include <cairo-pdf.h> -#endif -#ifdef CAIRO_HAS_PNG_SURFACE -# include <cairo-png.h> -#endif - -#include "ml_cairo_channel.h" -#include "ml_cairo_status.h" #include "ml_cairo.h" -static void -ml_final_cairo_t (value val) -{ - cairo_t *cr = cairo_t_val (val); - if (cr != NULL) - cairo_destroy (cr); -} - -static struct custom_operations ml_custom_cairo_t = { - "cairo_t/001", ml_final_cairo_t, ml_pointer_compare, - ml_pointer_hash, custom_serialize_default, custom_deserialize_default -}; - -value -Val_cairo_t (cairo_t * p) -{ - value ret; - struct ml_cairo *ml_c; - if (p == NULL) - report_null_pointer; - ret = alloc_custom (&ml_custom_cairo_t, sizeof (struct ml_cairo), 20, 1000); - ml_c = Data_custom_val (ret); - ml_c->cr = p; - ml_c->suspend_exn = 0; - return ret; -} - -Make_Val_final_pointer(cairo_surface_t, Id, cairo_surface_destroy, 20) - -Make_Val_final_pointer(cairo_matrix_t, Id, cairo_matrix_destroy, 100) - -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 -ml_cairo_suspend_exn (value v_cr) -{ - struct ml_cairo *ml_c = Data_custom_val (v_cr); - ml_c->suspend_exn = 1; - return Val_unit; -} - -CAMLprim value -ml_cairo_resume_exn (value v_cr) -{ - struct ml_cairo *ml_c = Data_custom_val (v_cr); - ml_c->suspend_exn = 0; - cairo_treat_status (cairo_status (ml_c->cr)); - return Val_unit; -} - -CAMLprim value -ml_cairo_get_suspend_exn (value v_cr) -{ - struct ml_cairo *ml_c = Data_custom_val (v_cr); - return Val_bool (ml_c->suspend_exn); -} - -ML_0(cairo_create, Val_cairo_t) +wMake_Val_final_pointer(cairo_t, cairo_destroy, 0) -/* ML_1(cairo_destroy, cairo_t_val, Unit) */ +wML_1(cairo_create, cairo_surface_t_val, Val_cairo_t) -CAMLprim value -ml_cairo_save (value v_cr) -{ - cairo_save (cairo_t_val (v_cr)); - check_cairo_status (v_cr); - return Val_unit; -} +/* cairo_reference */ +/* cairo_destroy */ -CAMLprim value -ml_cairo_restore (value v_cr) -{ - cairo_restore (cairo_t_val (v_cr)); - check_cairo_status (v_cr); - return Val_unit; -} -ML_2(cairo_copy, cairo_t_val, cairo_t_val, Unit) +wML_0_cairo(save) -CAMLprim value -ml_cairo_set_target_surface (value v_cr, value v_surface) -{ - cairo_set_target_surface (cairo_t_val (v_cr), - cairo_surface_t_val (v_surface)); - check_cairo_status (v_cr); - return Val_unit; -} - -CAMLprim value -ml_cairo_set_target_image (value cr, value img) -{ - cairo_set_target_image (cairo_t_val (cr), - Bp_val (Field (img, 0)), - cairo_format_t_val (Field (img, 1)), - Int_val (Field (img, 2)), - Int_val (Field (img, 3)), Int_val (Field (img, 4))); - check_cairo_status (cr); - return Val_unit; -} - -#ifdef CAIRO_HAS_PS_SURFACE -CAMLprim value -ml_cairo_set_target_ps (value v_cr, value v_file, value v_width_inches, - value v_height_inches, value v_x_pixels_per_inch, - value v_y_pixels_per_inch) -{ - cairo_set_target_ps (cairo_t_val (v_cr), FILE_val (v_file), - Double_val (v_width_inches), - Double_val (v_height_inches), - Double_val (v_x_pixels_per_inch), - Double_val (v_y_pixels_per_inch)); - check_cairo_status (v_cr); - return Val_unit; -} -#else -Unsupported(ml_cairo_set_target_ps) -#endif /* CAIRO_HAS_PS_SURFACE */ -ML_bc6(cairo_set_target_ps) - -#ifdef CAIRO_HAS_PDF_SURFACE -CAMLprim value -ml_cairo_set_target_pdf (value v_cr, value v_file, value v_width_inches, - value v_height_inches, value v_x_pixels_per_inch, - value v_y_pixels_per_inch) -{ - cairo_set_target_pdf (cairo_t_val (v_cr), FILE_val (v_file), - Double_val (v_width_inches), - Double_val (v_height_inches), - Double_val (v_x_pixels_per_inch), - Double_val (v_y_pixels_per_inch)); - check_cairo_status (v_cr); - return Val_unit; -} -#else -Unsupported(ml_cairo_set_target_pdf) -#endif /* CAIRO_HAS_PDF_SURFACE */ -ML_bc6(cairo_set_target_pdf) - -#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), - Int_val (v_width), Int_val (v_height)); - check_cairo_status (v_cr); - return Val_unit; -} -#else -Unsupported(ml_cairo_set_target_png) -#endif /* CAIRO_HAS_PNG_SURFACE */ +wML_0_cairo(restore) #define cairo_operator_t_val(v) ((cairo_operator_t) Int_val(v)) #define Val_cairo_operator_t(v) Val_int(v) -CAMLprim value -ml_cairo_set_operator (value v_cr, value v_op) -{ - cairo_set_operator (cairo_t_val (v_cr), cairo_operator_t_val (v_op)); - check_cairo_status (v_cr); - return Val_unit; -} +wML_1_cairo(set_operator, cairo_operator_t_val) -CAMLprim value -ml_cairo_set_rgb_color (value v_cr, value v_red, value v_green, value v_blue) -{ - cairo_set_rgb_color (cairo_t_val (v_cr), Double_val (v_red), - Double_val (v_green), Double_val (v_blue)); - check_cairo_status (v_cr); - return Val_unit; -} +wML_3_cairo(set_source_rgb, Double_val, Double_val, Double_val) -CAMLprim value -ml_cairo_set_pattern (value v_cr, value v_pattern) -{ - cairo_set_pattern (cairo_t_val (v_cr), cairo_pattern_t_val (v_pattern)); - check_cairo_status (v_cr); - return Val_unit; -} +wML_4_cairo(set_source_rgba, Double_val, Double_val, Double_val, Double_val) -CAMLprim value -ml_cairo_set_alpha (value v_cr, value v_alpha) -{ - cairo_set_alpha (cairo_t_val (v_cr), Double_val (v_alpha)); - check_cairo_status (v_cr); - return Val_unit; -} +wML_1_cairo(set_source, cairo_pattern_t_val) -CAMLprim value -ml_cairo_set_tolerance (value v_cr, value v_tolerance) -{ - cairo_set_tolerance (cairo_t_val (v_cr), Double_val (v_tolerance)); - check_cairo_status (v_cr); - return Val_unit; -} +wML_3_cairo(set_source_surface, cairo_surface_t_val, Double_val, Double_val) + +wML_1_cairo(set_tolerance, Double_val) #define cairo_fill_rule_t_val(v) ((cairo_fill_rule_t) Int_val(v)) #define Val_cairo_fill_rule_t(v) Val_int(v) -CAMLprim value -ml_cairo_set_fill_rule (value v_cr, value v_fill_rule) -{ - cairo_set_fill_rule (cairo_t_val (v_cr), - cairo_fill_rule_t_val (v_fill_rule)); - check_cairo_status (v_cr); - return Val_unit; -} +wML_1_cairo(set_fill_rule, cairo_fill_rule_t_val) -CAMLprim value -ml_cairo_set_line_width (value v_cr, value v_width) -{ - cairo_set_line_width (cairo_t_val (v_cr), Double_val (v_width)); - check_cairo_status (v_cr); - return Val_unit; -} +wML_1_cairo(set_line_width, Double_val) #define cairo_line_cap_t_val(v) ((cairo_line_cap_t) Int_val(v)) #define Val_cairo_line_cap_t(v) Val_int(v) -CAMLprim value -ml_cairo_set_line_cap (value v_cr, value v_line_cap) -{ - cairo_set_line_cap (cairo_t_val (v_cr), cairo_line_cap_t_val (v_line_cap)); - check_cairo_status (v_cr); - return Val_unit; -} +wML_1_cairo(set_line_cap, cairo_line_cap_t_val) #define cairo_line_join_t_val(v) ((cairo_line_join_t) Int_val(v)) #define Val_cairo_line_join_t(v) Val_int(v) -CAMLprim value -ml_cairo_set_line_join (value v_cr, value v_line_join) -{ - cairo_set_line_join (cairo_t_val (v_cr), - cairo_line_join_t_val (v_line_join)); - check_cairo_status (v_cr); - return Val_unit; -} +wML_1_cairo(set_line_join, cairo_line_join_t_val) CAMLprim value ml_cairo_set_dash (value cr, value d, value off) @@ -288,42 +69,24 @@ ml_cairo_set_dash (value cr, value d, value off) return Val_unit; } -CAMLprim value -ml_cairo_set_miter_limit (value v_cr, value v_limit) -{ - cairo_set_miter_limit (cairo_t_val (v_cr), Double_val (v_limit)); - check_cairo_status (v_cr); - return Val_unit; -} +wML_1_cairo(set_miter_limit, Double_val) -CAMLprim value -ml_cairo_translate (value v_cr, value v_tx, value v_ty) -{ - cairo_translate (cairo_t_val (v_cr), Double_val (v_tx), Double_val (v_ty)); - check_cairo_status (v_cr); - return Val_unit; -} +wML_2_cairo(translate, Double_val, Double_val) -CAMLprim value -ml_cairo_scale (value v_cr, value v_sx, value v_sy) -{ - cairo_scale (cairo_t_val (v_cr), Double_val (v_sx), Double_val (v_sy)); - check_cairo_status (v_cr); - return Val_unit; -} +wML_2_cairo(scale, Double_val, Double_val) -CAMLprim value -ml_cairo_rotate (value v_cr, value v_angle) -{ - cairo_rotate (cairo_t_val (v_cr), Double_val (v_angle)); - check_cairo_status (v_cr); - return Val_unit; -} +wML_1_cairo(rotate, Double_val) CAMLprim value -ml_cairo_concat_matrix (value v_cr, value v_matrix) +ml_cairo_transform (value v_cr, value v_matrix) { - cairo_concat_matrix (cairo_t_val (v_cr), cairo_matrix_t_val (v_matrix)); +#ifndef ARCH_ALIGN_DOUBLE + cairo_transform (cairo_t_val (v_cr), cairo_matrix_t_val (v_matrix)); +#else + cairo_matrix_t mat; + ml_convert_cairo_matrix_in (v_matrix, &mat); + cairo_transform (cairo_t_val (v_cr), &mat); +#endif check_cairo_status (v_cr); return Val_unit; } @@ -331,234 +94,131 @@ ml_cairo_concat_matrix (value v_cr, value v_matrix) CAMLprim value ml_cairo_set_matrix (value v_cr, value v_matrix) { +#ifndef ARCH_ALIGN_DOUBLE cairo_set_matrix (cairo_t_val (v_cr), cairo_matrix_t_val (v_matrix)); +#else + cairo_matrix_t mat; + ml_convert_cairo_matrix_in (v_matrix, &mat); + cairo_set_matrix (cairo_t_val (v_cr), &mat); +#endif check_cairo_status (v_cr); return Val_unit; } -CAMLprim value -ml_cairo_default_matrix (value v_cr) -{ - cairo_default_matrix (cairo_t_val (v_cr)); - check_cairo_status (v_cr); - return Val_unit; -} +wML_0_cairo (identity_matrix) -CAMLprim value -ml_cairo_identity_matrix (value v_cr) +value +ml_cairo_point (double x, double y) { - cairo_identity_matrix (cairo_t_val (v_cr)); - check_cairo_status (v_cr); - return Val_unit; + value p; + p = caml_alloc_small (2 * Double_wosize, Double_array_tag); + Store_double_field (p, 0, x); + Store_double_field (p, 1, y); + return p; } CAMLprim value -ml_cairo_transform_point (value cr, value p) +ml_cairo_user_to_device (value cr, value p) { double x, y; x = Double_field (p, 0); y = Double_field (p, 1); - cairo_transform_point (cairo_t_val (cr), &x, &y); + cairo_user_to_device (cairo_t_val (cr), &x, &y); check_cairo_status (cr); - Store_double_field (p, 0, x); - Store_double_field (p, 1, y); - return Val_unit; + return ml_cairo_point (x, y); } CAMLprim value -ml_cairo_transform_distance (value cr, value p) +ml_cairo_user_to_device_distance (value cr, value p) { double x, y; x = Double_field (p, 0); y = Double_field (p, 1); - cairo_transform_distance (cairo_t_val (cr), &x, &y); + cairo_user_to_device_distance (cairo_t_val (cr), &x, &y); check_cairo_status (cr); - Store_double_field (p, 0, x); - Store_double_field (p, 1, y); - return Val_unit; + return ml_cairo_point (x, y); } CAMLprim value -ml_cairo_inverse_transform_point (value cr, value p) +ml_cairo_device_to_user (value cr, value p) { - double x = Double_field (p, 0); - double y = Double_field (p, 1); - cairo_inverse_transform_point (cairo_t_val (cr), &x, &y); + double x, y; + x = Double_field (p, 0); + y = Double_field (p, 1); + cairo_device_to_user (cairo_t_val (cr), &x, &y); check_cairo_status (cr); - Store_double_field (p, 0, x); - Store_double_field (p, 1, y); - return Val_unit; + return ml_cairo_point (x, y); } CAMLprim value -ml_cairo_inverse_transform_distance (value cr, value p) +ml_cairo_device_to_user_distance (value cr, value p) { - double x = Double_field (p, 0); - double y = Double_field (p, 1); - cairo_inverse_transform_distance (cairo_t_val (cr), &x, &y); + double x, y; + x = Double_field (p, 0); + y = Double_field (p, 1); + cairo_device_to_user_distance (cairo_t_val (cr), &x, &y); check_cairo_status (cr); - Store_double_field (p, 0, x); - Store_double_field (p, 1, y); - return Val_unit; + return ml_cairo_point (x, y); } -CAMLprim value -ml_cairo_new_path (value v_cr) -{ - cairo_new_path (cairo_t_val (v_cr)); - check_cairo_status (v_cr); - return Val_unit; -} +wML_0_cairo(new_path) -CAMLprim value -ml_cairo_move_to (value v_cr, value v_x, value v_y) -{ - cairo_move_to (cairo_t_val (v_cr), Double_val (v_x), Double_val (v_y)); - check_cairo_status (v_cr); - return Val_unit; -} +wML_2_cairo(move_to, Double_val, Double_val) -CAMLprim value -ml_cairo_line_to (value v_cr, value v_x, value v_y) -{ - cairo_line_to (cairo_t_val (v_cr), Double_val (v_x), Double_val (v_y)); - check_cairo_status (v_cr); - return Val_unit; -} +wML_2_cairo(line_to, Double_val, Double_val) -CAMLprim value -ml_cairo_curve_to (value v_cr, value v_x1, value v_y1, value v_x2, value v_y2, - value v_x3, value v_y3) -{ - cairo_curve_to (cairo_t_val (v_cr), Double_val (v_x1), Double_val (v_y1), - Double_val (v_x2), Double_val (v_y2), Double_val (v_x3), - Double_val (v_y3)); - check_cairo_status (v_cr); - return Val_unit; -} -ML_bc7(cairo_curve_to) +wML_6_cairo(curve_to, Double_val, Double_val, Double_val, Double_val, Double_val, Double_val) -CAMLprim value -ml_cairo_arc (value v_cr, value v_xc, value v_yc, value v_radius, - value v_angle1, value v_angle2) -{ - cairo_arc (cairo_t_val (v_cr), Double_val (v_xc), Double_val (v_yc), - Double_val (v_radius), Double_val (v_angle1), - Double_val (v_angle2)); - check_cairo_status (v_cr); - return Val_unit; -} -ML_bc6(cairo_arc) +wML_5_cairo(arc, Double_val, Double_val, Double_val, Double_val, Double_val) -CAMLprim value -ml_cairo_arc_negative (value v_cr, value v_xc, value v_yc, value v_radius, - value v_angle1, value v_angle2) -{ - cairo_arc_negative (cairo_t_val (v_cr), Double_val (v_xc), - Double_val (v_yc), Double_val (v_radius), - Double_val (v_angle1), Double_val (v_angle2)); - check_cairo_status (v_cr); - return Val_unit; -} -ML_bc6(cairo_arc_negative) +wML_5_cairo(arc_negative, Double_val, Double_val, Double_val, Double_val, Double_val) -CAMLprim value -ml_cairo_rel_move_to (value v_cr, value v_dx, value v_dy) -{ - cairo_rel_move_to (cairo_t_val (v_cr), Double_val (v_dx), - Double_val (v_dy)); - check_cairo_status (v_cr); - return Val_unit; -} +wML_2_cairo(rel_move_to, Double_val, Double_val) -CAMLprim value -ml_cairo_rel_line_to (value v_cr, value v_dx, value v_dy) -{ - cairo_rel_line_to (cairo_t_val (v_cr), Double_val (v_dx), - Double_val (v_dy)); - check_cairo_status (v_cr); - return Val_unit; -} +wML_2_cairo(rel_line_to, Double_val, Double_val) -CAMLprim value -ml_cairo_rel_curve_to (value v_cr, value v_dx1, value v_dy1, value v_dx2, - value v_dy2, value v_dx3, value v_dy3) -{ - cairo_rel_curve_to (cairo_t_val (v_cr), Double_val (v_dx1), - Double_val (v_dy1), Double_val (v_dx2), - Double_val (v_dy2), Double_val (v_dx3), - Double_val (v_dy3)); - check_cairo_status (v_cr); - return Val_unit; -} -ML_bc7(cairo_rel_curve_to) +wML_6_cairo(rel_curve_to, Double_val, Double_val, Double_val, Double_val, Double_val, Double_val) -CAMLprim value -ml_cairo_rectangle (value v_cr, value v_x, value v_y, value v_width, - value v_height) -{ - cairo_rectangle (cairo_t_val (v_cr), Double_val (v_x), Double_val (v_y), - Double_val (v_width), Double_val (v_height)); - check_cairo_status (v_cr); - return Val_unit; -} +wML_4_cairo(rectangle, Double_val, Double_val, Double_val, Double_val) -CAMLprim value -ml_cairo_close_path (value v_cr) -{ - cairo_close_path (cairo_t_val (v_cr)); - check_cairo_status (v_cr); - return Val_unit; -} +wML_0_cairo(close_path) -CAMLprim value -ml_cairo_stroke (value v_cr) -{ - cairo_stroke (cairo_t_val (v_cr)); - check_cairo_status (v_cr); - return Val_unit; -} +wML_0_cairo(paint) -CAMLprim value -ml_cairo_fill (value v_cr) -{ - cairo_fill (cairo_t_val (v_cr)); - check_cairo_status (v_cr); - return Val_unit; -} +wML_1_cairo(paint_with_alpha, Double_val) -CAMLprim value -ml_cairo_copy_page (value v_cr) -{ - cairo_copy_page (cairo_t_val (v_cr)); - check_cairo_status (v_cr); - return Val_unit; -} +wML_1_cairo(mask, cairo_pattern_t_val) -CAMLprim value -ml_cairo_show_page (value v_cr) -{ - cairo_show_page (cairo_t_val (v_cr)); - check_cairo_status (v_cr); - return Val_unit; -} +wML_3_cairo(mask_surface, cairo_surface_t_val, Double_val, Double_val) + +wML_0_cairo(stroke) + +wML_0_cairo(stroke_preserve) + +wML_0_cairo(fill) + +wML_0_cairo(fill_preserve) + +wML_0_cairo(copy_page) + +wML_0_cairo(show_page) CAMLprim value -ml_cairo_in_stroke (value v_cr, value v_x, value v_y) +ml_cairo_in_stroke (value v_cr, value p) { - int c_ret; + cairo_bool_t c_ret; c_ret = - cairo_in_stroke (cairo_t_val (v_cr), Double_val (v_x), Double_val (v_y)); + cairo_in_stroke (cairo_t_val (v_cr), Double_field (p, 0), Double_field (p, 1)); check_cairo_status (v_cr); return Val_bool (c_ret); } CAMLprim value -ml_cairo_in_fill (value v_cr, value v_x, value v_y) +ml_cairo_in_fill (value v_cr, value p) { - int c_ret; + cairo_bool_t c_ret; c_ret = - cairo_in_fill (cairo_t_val (v_cr), Double_val (v_x), Double_val (v_y)); + cairo_in_fill (cairo_t_val (v_cr), Double_field (p, 0), Double_field (p, 1)); check_cairo_status (v_cr); return Val_bool (c_ret); } @@ -572,11 +232,11 @@ ml_cairo_stroke_extents (value 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)); + t = caml_alloc_tuple (4); + Store_field (t, 0, caml_copy_double (x1)); + Store_field (t, 1, caml_copy_double (y1)); + Store_field (t, 2, caml_copy_double (x2)); + Store_field (t, 3, caml_copy_double (y2)); CAMLreturn (t); } } @@ -590,529 +250,270 @@ ml_cairo_fill_extents (value 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)); + t = caml_alloc_tuple (4); + Store_field (t, 0, caml_copy_double (x1)); + Store_field (t, 1, caml_copy_double (y1)); + Store_field (t, 2, caml_copy_double (x2)); + Store_field (t, 3, caml_copy_double (y2)); CAMLreturn (t); } } -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; -} +wML_0_cairo(clip) -CAMLprim value -ml_cairo_clip (value v_cr) -{ - cairo_clip (cairo_t_val (v_cr)); - check_cairo_status (v_cr); - return Val_unit; -} - -Make_Val_final_pointer(cairo_font_t, Id, cairo_font_destroy, 20) - -static void -cairo_glyph_t_val (cairo_glyph_t * _s, value _v) -{ - _s->index = Long_val (Field (_v, 0)); - _s->x = Double_val (Field (_v, 1)); - _s->y = Double_val (Field (_v, 2)); -} +wML_0_cairo(clip_preserve) -static value -Val_cairo_font_extents_t (cairo_font_extents_t * _s) -{ - value _v; - _v = alloc_small (5 * Double_wosize, Double_array_tag); - Store_double_field (_v, 0, _s->ascent); - Store_double_field (_v, 1, _s->descent); - Store_double_field (_v, 2, _s->height); - Store_double_field (_v, 3, _s->max_x_advance); - Store_double_field (_v, 4, _s->max_y_advance); - return _v; -} +wML_0_cairo(reset_clip) -static value -Val_cairo_text_extents_t (cairo_text_extents_t * _s) -{ - value _v; - _v = alloc_small (6 * Double_wosize, Double_array_tag); - Store_double_field (_v, 0, _s->x_bearing); - Store_double_field (_v, 1, _s->y_bearing); - Store_double_field (_v, 2, _s->width); - Store_double_field (_v, 3, _s->height); - Store_double_field (_v, 4, _s->x_advance); - Store_double_field (_v, 5, _s->y_advance); - return _v; -} + #define cairo_font_weight_t_val(v) ((cairo_font_weight_t) Int_val(v)) #define Val_cairo_font_weight_t(v) Val_int(v) #define cairo_font_slant_t_val(v) ((cairo_font_slant_t) Int_val(v)) #define Val_cairo_font_slant_t(v) Val_int(v) -CAMLprim value -ml_cairo_select_font (value v_ct, value v_family, value v_slant, - value v_weight) -{ - cairo_select_font (cairo_t_val (v_ct), String_val (v_family), - cairo_font_slant_t_val (v_slant), - cairo_font_weight_t_val (v_weight)); - check_cairo_status (v_ct); - return Val_unit; -} +wML_3_cairo(select_font_face, String_val, cairo_font_slant_t_val, cairo_font_weight_t_val) -CAMLprim value -ml_cairo_scale_font (value v_cr, value v_scale) -{ - cairo_scale_font (cairo_t_val (v_cr), Double_val (v_scale)); - check_cairo_status (v_cr); - return Val_unit; -} +wML_1_cairo(set_font_size, Double_val) CAMLprim value -ml_cairo_transform_font (value v_cr, value v_matrix) +ml_cairo_set_font_matrix (value v_cr, value v_matrix) { - cairo_transform_font (cairo_t_val (v_cr), cairo_matrix_t_val (v_matrix)); +#ifndef ARCH_ALIGN_DOUBLE + cairo_set_font_matrix (cairo_t_val (v_cr), cairo_matrix_t_val (v_matrix)); +#else + cairo_matrix_t mat; + ml_convert_cairo_matrix_in (v_matrix, &mat); + cairo_set_font_matrix (cairo_t_val (v_cr), &mat); +#endif check_cairo_status (v_cr); return Val_unit; } CAMLprim value -ml_cairo_show_text (value v_ct, value v_utf8) +ml_cairo_get_font_matrix (value v_cr) { - cairo_show_text (cairo_t_val (v_ct), String_val (v_utf8)); - check_cairo_status (v_ct); - return Val_unit; +#ifndef ARCH_ALIGN_DOUBLE + CAMLparam1(v_cr); + value v = cairo_matrix_alloc(); + cairo_get_font_matrix (cairo_t_val (v_cr), cairo_matrix_t_val (v)); + CAMLreturn(v); +#else + cairo_matrix_t mat; + cairo_get_font_matrix (cairo_t_val (v_cr), &mat); + check_cairo_status (v_cr); + return ml_convert_cairo_matrix_out (&mat); +#endif } -CAMLprim value -ml_cairo_show_glyphs (value v_ct, value v_glyphs) -{ - size_t num_glyphs = Wosize_val (v_glyphs); - cairo_glyph_t c_glyphs[num_glyphs]; - unsigned int i; - for (i = 0; i < num_glyphs; i++) - cairo_glyph_t_val (&c_glyphs[i], Field (v_glyphs, i)); - cairo_show_glyphs (cairo_t_val (v_ct), c_glyphs, num_glyphs); - check_cairo_status (v_ct); - return Val_unit; -} +wML_1_cairo(show_text, String_val) -CAMLprim value -ml_cairo_current_font (value cr) +cairo_glyph_t * +ml_convert_cairo_glypth_in (value v, int *num_glyphs) { - cairo_font_t *f = cairo_current_font (cairo_t_val (cr)); - check_cairo_status (cr); - cairo_font_reference (f); - return Val_cairo_font_t (f); -} - -CAMLprim value -ml_cairo_current_font_extents (value cr) -{ - cairo_font_extents_t e; - cairo_current_font_extents (cairo_t_val (cr), &e); - check_cairo_status (cr); - return Val_cairo_font_extents_t (&e); + size_t i, n = Wosize_val (v); + cairo_glyph_t *g = caml_stat_alloc (n * sizeof (cairo_glyph_t)); + for (i = 0; i < n; i++) + { + value vg = Field (v, i); + g[i].index = Unsigned_long_val (Field (vg, 0)); + g[i].x = Double_val (Field (vg, 1)); + g[i].y = Double_val (Field (vg, 2)); + } + *num_glyphs = n; + return g; } CAMLprim value -ml_cairo_set_font (value v_ct, value v_font) +ml_cairo_show_glyphs (value v_cr, value v_glyphs) { - cairo_set_font (cairo_t_val (v_ct), cairo_font_t_val (v_font)); - check_cairo_status (v_ct); + int num_glyphs; + cairo_glyph_t *c_glyphs; + c_glyphs = ml_convert_cairo_glypth_in (v_glyphs, &num_glyphs); + cairo_show_glyphs (cairo_t_val (v_cr), c_glyphs, num_glyphs); + caml_stat_free (c_glyphs); + check_cairo_status (v_cr); return Val_unit; } -CAMLprim value -ml_cairo_text_extents (value v_ct, value v_utf8) -{ - cairo_text_extents_t c_extents; - cairo_text_extents (cairo_t_val (v_ct), String_val (v_utf8), &c_extents); - check_cairo_status (v_ct); - return Val_cairo_text_extents_t (&c_extents); -} - -CAMLprim value -ml_cairo_glyph_extents (value v_ct, value v_glyphs) -{ - size_t num_glyphs = Wosize_val (v_glyphs); - cairo_text_extents_t c_extents; - cairo_glyph_t c_glyphs[num_glyphs]; - unsigned int i; - for (i = 0; i < num_glyphs; i++) - cairo_glyph_t_val (&c_glyphs[i], Field (v_glyphs, i)); - cairo_glyph_extents (cairo_t_val (v_ct), c_glyphs, num_glyphs, &c_extents); - check_cairo_status (v_ct); - return Val_cairo_text_extents_t (&c_extents); -} +wML_1 (cairo_get_font_face, cairo_t_val, Val_cairo_font_face_ref) -CAMLprim value -ml_cairo_text_path (value v_ct, value v_utf8) -{ - cairo_text_path (cairo_t_val (v_ct), String_val (v_utf8)); - check_cairo_status (v_ct); - return Val_unit; -} - -CAMLprim value -ml_cairo_glyph_path (value v_ct, value v_glyphs) -{ - size_t num_glyphs = Wosize_val (v_glyphs); - cairo_glyph_t c_glyphs[num_glyphs]; - unsigned int i; - for (i = 0; i < num_glyphs; i++) - cairo_glyph_t_val (&c_glyphs[i], Field (v_glyphs, i)); - cairo_glyph_path (cairo_t_val (v_ct), c_glyphs, num_glyphs); - check_cairo_status (v_ct); - return Val_unit; +value +Val_cairo_font_extents (cairo_font_extents_t * s) +{ + value v = caml_alloc_small (5 * Double_wosize, Double_array_tag); + Store_double_field (v, 0, s->ascent); + Store_double_field (v, 1, s->descent); + Store_double_field (v, 2, s->height); + Store_double_field (v, 3, s->max_x_advance); + Store_double_field (v, 4, s->max_y_advance); + return v; } -/* ML_1(cairo_font_destroy, cairo_font_t_val, Unit) */ - CAMLprim value -ml_cairo_font_extents (value font, value matrix) +ml_cairo_font_extents (value cr) { cairo_font_extents_t e; - cairo_status_t status; - status = cairo_font_extents (cairo_font_t_val (font), cairo_matrix_t_val (matrix), &e); - cairo_treat_status (status); - return Val_cairo_font_extents_t (&e); -} - -CAMLprim value -ml_cairo_font_glyph_extents (value v_font, value v_matrix, value v_glyphs) -{ - size_t num_glyphs = Wosize_val (v_glyphs); - cairo_text_extents_t c_extents; - cairo_glyph_t c_glyphs[num_glyphs]; - unsigned int i; - for (i = 0; i < num_glyphs; i++) - cairo_glyph_t_val (&c_glyphs[i], Field (v_glyphs, i)); - cairo_font_glyph_extents (cairo_font_t_val (v_font), cairo_matrix_t_val (v_matrix), - c_glyphs, num_glyphs, &c_extents); - return Val_cairo_text_extents_t (&c_extents); -} - -CAMLprim value -ml_cairo_show_surface (value v_cr, value v_surface, value v_width, - value v_height) -{ - cairo_show_surface (cairo_t_val (v_cr), cairo_surface_t_val (v_surface), - Int_val (v_width), Int_val (v_height)); - check_cairo_status (v_cr); - return Val_unit; -} - -CAMLprim value -ml_cairo_current_operator (value v_cr) -{ - cairo_operator_t c_ret; - c_ret = cairo_current_operator (cairo_t_val (v_cr)); - check_cairo_status (v_cr); - return Val_cairo_operator_t (c_ret); -} - -CAMLprim value -ml_cairo_current_rgb_color (value cr) -{ - CAMLparam1 (cr); - CAMLlocal4 (v, vr, vg, vb); - double r, g, b; - cairo_current_rgb_color (cairo_t_val (cr), &r, &g, &b); + cairo_font_extents (cairo_t_val (cr), &e); check_cairo_status (cr); - vr = copy_double (r); - vg = copy_double (g); - vb = copy_double (b); - v = alloc_small (3, 0); - Field (v, 0) = vr; - Field (v, 1) = vg; - Field (v, 2) = vb; - CAMLreturn (v); + return Val_cairo_font_extents (&e); } -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); -} +wML_1_cairo (set_font_face, cairo_font_face_t_val) -CAMLprim value -ml_cairo_current_alpha (value v_cr) -{ - double c_ret; - c_ret = cairo_current_alpha (cairo_t_val (v_cr)); - check_cairo_status (v_cr); - return copy_double (c_ret); -} - -CAMLprim value -ml_cairo_current_tolerance (value v_cr) -{ - double c_ret; - c_ret = cairo_current_tolerance (cairo_t_val (v_cr)); - check_cairo_status (v_cr); - return copy_double (c_ret); -} - -CAMLprim value -ml_cairo_current_point (value cr) -{ - value v; - double x, y; - cairo_current_point (cairo_t_val (cr), &x, &y); - check_cairo_status (cr); - v = alloc_small (2 * Double_wosize, Double_array_tag); - Store_double_field (v, 0, x); - Store_double_field (v, 1, y); +value +Val_cairo_text_extents (cairo_text_extents_t * s) +{ + value v = caml_alloc_small (6 * Double_wosize, Double_array_tag); + Store_double_field (v, 0, s->x_bearing); + Store_double_field (v, 1, s->y_bearing); + Store_double_field (v, 2, s->width); + Store_double_field (v, 3, s->height); + Store_double_field (v, 4, s->x_advance); + Store_double_field (v, 5, s->y_advance); return v; } CAMLprim value -ml_cairo_current_fill_rule (value v_cr) +ml_cairo_text_extents (value v_cr, value v_utf8) { - cairo_fill_rule_t c_ret; - c_ret = cairo_current_fill_rule (cairo_t_val (v_cr)); + cairo_text_extents_t c_extents; + cairo_text_extents (cairo_t_val (v_cr), String_val (v_utf8), &c_extents); check_cairo_status (v_cr); - return Val_cairo_fill_rule_t (c_ret); + return Val_cairo_text_extents (&c_extents); } CAMLprim value -ml_cairo_current_line_width (value v_cr) +ml_cairo_glyph_extents (value v_cr, value v_glyphs) { - double c_ret; - c_ret = cairo_current_line_width (cairo_t_val (v_cr)); + int num_glyphs; + cairo_glyph_t *c_glyphs; + cairo_text_extents_t c_extents; + c_glyphs = ml_convert_cairo_glypth_in (v_glyphs, &num_glyphs); + cairo_glyph_extents (cairo_t_val (v_cr), c_glyphs, num_glyphs, &c_extents); + caml_stat_free (c_glyphs); check_cairo_status (v_cr); - return copy_double (c_ret); + return Val_cairo_text_extents (&c_extents); } -CAMLprim value -ml_cairo_current_line_cap (value v_cr) -{ - cairo_line_cap_t c_ret; - c_ret = cairo_current_line_cap (cairo_t_val (v_cr)); - check_cairo_status (v_cr); - return Val_cairo_line_cap_t (c_ret); -} +wML_1_cairo(text_path, String_val) CAMLprim value -ml_cairo_current_line_join (value v_cr) +ml_cairo_glyph_path (value v_cr, value v_glyphs) { - cairo_line_join_t c_ret; - c_ret = cairo_current_line_join (cairo_t_val (v_cr)); + int num_glyphs; + cairo_glyph_t *c_glyphs; + c_glyphs = ml_convert_cairo_glypth_in (v_glyphs, &num_glyphs); + cairo_glyph_path (cairo_t_val (v_cr), c_glyphs, num_glyphs); + caml_stat_free (c_glyphs); check_cairo_status (v_cr); - return Val_cairo_line_join_t (c_ret); + return Val_unit; } -CAMLprim value -ml_cairo_current_miter_limit (value v_cr) -{ - double c_ret; - c_ret = cairo_current_miter_limit (cairo_t_val (v_cr)); - check_cairo_status (v_cr); - return copy_double (c_ret); -} + +#define cairo_get(cname, conv) wML_1(cairo_get_##cname, cairo_t_val, conv) -CAMLprim value -ml_cairo_current_matrix (value v_cr, value v_matrix) -{ - cairo_current_matrix (cairo_t_val (v_cr), cairo_matrix_t_val (v_matrix)); - check_cairo_status (v_cr); - return Val_unit; -} +cairo_get(operator, Val_cairo_operator_t) -CAMLprim value -ml_cairo_current_target_surface (value cr) -{ - cairo_surface_t *s = cairo_current_target_surface (cairo_t_val (cr)); - check_cairo_status (cr); - cairo_surface_reference (s); - return Val_cairo_surface_t (s); -} +cairo_get(source, Val_cairo_pattern_ref) -CAMLprim value -ml_cairo_status (value v_cr) -{ - value v; - int status = cairo_status (cairo_t_val (v_cr)); - if (status == CAIRO_STATUS_SUCCESS) - v = Val_unit; - else - { - v = alloc_small (1, 0); - Field (v, 0) = Val_int (status - 1); - } - return v; -} -ML_1(cairo_status_string, cairo_t_val, copy_string) +cairo_get(tolerance, caml_copy_double) CAMLprim value -ml_cairo_surface_create_for_image (value img) +ml_cairo_get_current_point (value cr) { - cairo_surface_t *s; - s = cairo_surface_create_for_image (Bp_val (Field (img, 0)), - cairo_format_t_val (Field (img, 1)), - Int_val (Field (img, 2)), - Int_val (Field (img, 3)), - Int_val (Field (img, 4))); - return Val_cairo_surface_t (s); + double x, y; + cairo_get_current_point (cairo_t_val (cr), &x, &y); + return ml_cairo_point (x, y); } -ML_4(cairo_surface_create_similar, cairo_surface_t_val, cairo_format_t_val, Int_val, Int_val, Val_cairo_surface_t) -/* ML_1(cairo_surface_destroy, cairo_surface_t_val, Unit) */ +cairo_get(fill_rule, Val_cairo_fill_rule_t) -ML_2(cairo_surface_set_repeat, cairo_surface_t_val, Int_val, Val_cairo_status_t) -ML_2(cairo_surface_set_matrix, cairo_surface_t_val, cairo_matrix_t_val, Val_cairo_status_t) -ML_2(cairo_surface_get_matrix, cairo_surface_t_val, cairo_matrix_t_val, Val_cairo_status_t) +cairo_get(line_width, caml_copy_double) -#define cairo_filter_t_val(v) ((cairo_filter_t) Int_val(v)) -#define Val_cairo_filter_t(v) Val_int(v) +cairo_get(line_cap, Val_cairo_line_cap_t) -ML_2(cairo_surface_set_filter, cairo_surface_t_val, cairo_filter_t_val, Val_cairo_status_t) -ML_1(cairo_surface_get_filter, cairo_surface_t_val, Val_cairo_filter_t) +cairo_get(line_join, Val_cairo_line_join_t) -ML_3(cairo_image_surface_create, cairo_format_t_val, Int_val, Int_val, Val_cairo_surface_t) +cairo_get(miter_limit, caml_copy_double) CAMLprim value -ml_cairo_image_surface_create_for_data (value img) +ml_cairo_get_matrix (value v_cr) { - cairo_surface_t *s; - s = cairo_image_surface_create_for_data (Bp_val (Field (img, 0)), - cairo_format_t_val (Field - (img, 1)), - Int_val (Field (img, 2)), - Int_val (Field (img, 3)), - Int_val (Field (img, 4))); - return Val_cairo_surface_t (s); +#ifndef ARCH_ALIGN_DOUBLE + CAMLparam1(v_cr); + value v = cairo_matrix_alloc(); + cairo_get_matrix (cairo_t_val (v_cr), cairo_matrix_t_val (v)); + CAMLreturn(v); +#else + cairo_matrix_t mat; + cairo_get_matrix (cairo_t_val (v_cr), &mat); + return ml_convert_cairo_matrix_out (&mat); +#endif } -#ifdef CAIRO_HAS_PS_SURFACE -ML_5(cairo_ps_surface_create, FILE_val, Double_val, Double_val, Double_val, Double_val, Val_cairo_surface_t) -#else -Unsupported(ml_cairo_ps_surface_create) -#endif /* CAIRO_HAS_PS_SURFACE */ +cairo_get(target, Val_cairo_surface_ref) -#ifdef CAIRO_HAS_PDF_SURFACE -ML_5(cairo_pdf_surface_create, FILE_val, Double_val, Double_val, Double_val, Double_val, Val_cairo_surface_t) -#else -Unsupported(ml_cairo_pdf_surface_create) -#endif /* CAIRO_HAS_PDF_SURFACE */ +/* ml_cairo_path */ +/* ml_cairo_status */ -#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_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) - -#define cairo_extend_t_val(v) ((cairo_extend_t) Int_val(v)) -#define Val_cairo_extend_t(v) Val_int(v) - -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) - -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) -ML_1(cairo_matrix_set_identity, cairo_matrix_t_val, Val_cairo_status_t) -CAMLprim value -ml_cairo_matrix_set_affine (value m, value aff) + +value * +ml_cairo_make_root (value v) { - if (Double_array_length (aff) != 6) - invalid_argument ("not a matrix"); - - cairo_matrix_set_affine (cairo_matrix_t_val (m), - Double_field (aff, 0), - Double_field (aff, 1), - Double_field (aff, 2), - Double_field (aff, 3), - Double_field (aff, 4), Double_field (aff, 5)); - return Val_unit; + value *root = caml_stat_alloc (sizeof (value *)); + *root = v; + caml_register_global_root (root); + return root; } -CAMLprim value -ml_cairo_matrix_get_affine (value m) +value * +ml_cairo_make_closure (value f) { - CAMLparam1 (m); - CAMLlocal1 (v); - double a, b, c, d, tx, ty; - cairo_matrix_get_affine (cairo_matrix_t_val (m), &a, &b, &c, &d, &tx, &ty); - v = alloc_small (6 * Double_wosize, Double_array_tag); - Store_double_field (v, 0, a); - Store_double_field (v, 1, b); - Store_double_field (v, 2, c); - Store_double_field (v, 3, d); - Store_double_field (v, 4, tx); - Store_double_field (v, 5, ty); - CAMLreturn (v); + CAMLparam1(f); + value c; + c = caml_alloc_small (2, 0); + Field (c, 0) = f; + Field (c, 1) = Val_unit; + CAMLreturn (ml_cairo_make_root (c)); } -ML_3(cairo_matrix_translate, cairo_matrix_t_val, Double_val, Double_val, Val_cairo_status_t) -ML_3(cairo_matrix_scale, cairo_matrix_t_val, Double_val, Double_val, Val_cairo_status_t) -ML_2(cairo_matrix_rotate, cairo_matrix_t_val, Double_val, Val_cairo_status_t) -ML_1(cairo_matrix_invert, cairo_matrix_t_val, Val_cairo_status_t) -ML_3(cairo_matrix_multiply, cairo_matrix_t_val, cairo_matrix_t_val, cairo_matrix_t_val, Val_cairo_status_t) - -CAMLprim value -ml_cairo_matrix_transform_distance (value m, value p) +cairo_status_t +ml_cairo_write_func (void *closure, const unsigned char *data, unsigned int length) { - cairo_status_t s; - double x, y; - x = Double_field (p, 0); - y = Double_field (p, 1); - s = cairo_matrix_transform_distance (cairo_matrix_t_val (m), &x, &y); - Store_double_field (p, 0, x); - Store_double_field (p, 1, y); - return Val_cairo_status_t (s); + value s, res, *c = closure; + s = caml_alloc_string (length); + memcpy (String_val (s), data, length); + res = caml_callback_exn (Field (*c, 0), s); + if (Is_exception_result (res)) + { + Store_field (*c, 1, res); + return CAIRO_STATUS_WRITE_ERROR; + } + return CAIRO_STATUS_SUCCESS; } -CAMLprim value -ml_cairo_matrix_transform_point (value m, value p) +cairo_status_t +ml_cairo_read_func (void *closure, unsigned char *data, unsigned int length) { - cairo_status_t s; - double x, y; - x = Double_field (p, 0); - y = Double_field (p, 1); - s = cairo_matrix_transform_point (cairo_matrix_t_val (m), &x, &y); - Store_double_field (p, 0, x); - Store_double_field (p, 1, y); - return Val_cairo_status_t (s); + value s, res, *c = closure; + s = caml_alloc_string (length); + res = caml_callback_exn (Field (*c, 0), s); + if (Is_exception_result (res)) + { + Store_field (*c, 1, res); + return CAIRO_STATUS_READ_ERROR; + } + memcpy (data, String_val (s), length); + return CAIRO_STATUS_SUCCESS; } -CAMLprim value -ml_cairo_finalise_target (value cr) -{ - cairo_set_target_surface (cairo_t_val (cr), NULL); - return Val_unit; -} -CAMLprim value -ml_cairo_surface_finalise (value s) -{ - cairo_surface_t *surf = cairo_surface_t_val (s); - cairo_surface_destroy (surf); - Store_pointer (s, NULL); - return Val_unit; -} + +wML_3(cairo_image_surface_create, cairo_format_t_val, Int_val, Int_val, Val_cairo_surface_t) + +/* image_surface_create_for_data */ + +wML_1 (cairo_image_surface_get_width, cairo_surface_t_val, Val_int) +wML_1 (cairo_image_surface_get_height, cairo_surface_t_val, Val_int) |