diff options
author | Olivier Andrieu <oandrieu@gmail.com> | 2006-11-08 23:42:34 +0000 |
---|---|---|
committer | Hezekiah M. Carty <hcarty@atmos.umd.edu> | 2009-06-18 14:01:38 -0400 |
commit | 7bb5641a396cb618399c2dcae304051ad952d86b (patch) | |
tree | ae3a76ab24b08495d311b39ea2175eb81021ab1a | |
parent | 14f6316fd8c180def30f42d6120e68d2e4654c13 (diff) |
Bump to Cairo 1.2
* configure.ac: require cairo 1.2, bump version number to 1.2
* src/*: syc with cairo 1.2
* src/ml_cairo_lablgtk.c: require GTK+ 2.8 now
-rw-r--r-- | ChangeLog | 6 | ||||
-rw-r--r-- | configure.ac | 4 | ||||
-rw-r--r-- | src/cairo.ml | 131 | ||||
-rw-r--r-- | src/cairo.mli | 88 | ||||
-rw-r--r-- | src/cairo_ft.ml | 9 | ||||
-rw-r--r-- | src/cairo_ft.mli | 4 | ||||
-rw-r--r-- | src/cairo_pdf.ml | 9 | ||||
-rw-r--r-- | src/cairo_pdf.mli | 4 | ||||
-rw-r--r-- | src/cairo_ps.ml | 13 | ||||
-rw-r--r-- | src/cairo_ps.mli | 4 | ||||
-rw-r--r-- | src/cairo_svg.ml | 10 | ||||
-rw-r--r-- | src/cairo_svg.mli | 10 | ||||
-rw-r--r-- | src/ml_cairo.c | 39 | ||||
-rw-r--r-- | src/ml_cairo.h | 10 | ||||
-rw-r--r-- | src/ml_cairo_bigarr.c | 2 | ||||
-rw-r--r-- | src/ml_cairo_font.c | 115 | ||||
-rw-r--r-- | src/ml_cairo_ft.c | 2 | ||||
-rw-r--r-- | src/ml_cairo_lablgtk.c | 184 | ||||
-rw-r--r-- | src/ml_cairo_matrix.c | 2 | ||||
-rw-r--r-- | src/ml_cairo_path.c | 8 | ||||
-rw-r--r-- | src/ml_cairo_pattern.c | 3 | ||||
-rw-r--r-- | src/ml_cairo_pdf.c | 4 | ||||
-rw-r--r-- | src/ml_cairo_ps.c | 12 | ||||
-rw-r--r-- | src/ml_cairo_surface.c | 45 | ||||
-rw-r--r-- | src/ml_cairo_svg.c | 10 | ||||
-rw-r--r-- | src/ml_cairo_wrappers.h | 6 |
26 files changed, 445 insertions, 289 deletions
@@ -1,3 +1,9 @@ +2006-11-09 Olivier Andrieu <oandrieu@gmail.com> + + * configure.ac: require cairo 1.2, bump version number to 1.2 + * src/*: syc with cairo 1.2 + * src/ml_cairo_lablgtk.c: require GTK+ 2.8 now + 2006-02-09 Olivier Andrieu <oliv__a@users.sourceforge.net> * src/cairo_svg.mli, src/cairo_svg.mli, src/ml_cairo_svg.c: diff --git a/configure.ac b/configure.ac index cadbe62..6bd902a 100644 --- a/configure.ac +++ b/configure.ac @@ -1,4 +1,4 @@ -AC_INIT(CAIRO_OCAML, 1.0.0) +AC_INIT(CAIRO_OCAML, 1.2.0) AC_CONFIG_SRCDIR(src/cairo.ml) AC_CONFIG_AUX_DIR(support) @@ -6,7 +6,7 @@ AC_CONFIG_AUX_DIR(support) AC_PROG_OCAML() # Check for cairo -PKG_CHECK_MODULES(CAIRO, cairo >= 1.0.0 freetype2) +PKG_CHECK_MODULES(CAIRO, cairo >= 1.2 freetype2) # Optional GTK support (for the X11 backend) AC_ARG_WITH(gtk, diff --git a/src/cairo.ml b/src/cairo.ml index 6d7a3bc..7ac4442 100644 --- a/src/cairo.ml +++ b/src/cairo.ml @@ -27,6 +27,9 @@ type status = | INVALID_VISUAL | FILE_NOT_FOUND | INVALID_DASH + | INVALID_DSC_COMMENT + | INVALID_INDEX + | CLIP_NOT_REPRESENTABLE exception Error of status let init = Callback.register_exception "cairo_status_exn" (Error NULL_POINTER) @@ -43,6 +46,26 @@ type -'a surface type -'a pattern type -'a font_face +type surface_type = [ + | `Image + | `PDF | `PS | `SVG + | `Xlib | `XCB + | `Glitz | `Quartz | `Win32 | `BeOS | `DirectFB ] +type pattern_type = [ + | `Solid + | `Surface + | `Linear | `Radial ] +type font_type = [ + | `TOY + | `FT + | `Win32 + | `ATSUI ] + +type content = + CONTENT_COLOR + | CONTENT_ALPHA + | CONTENT_COLOR_ALPHA + type point = { x : float ; y : float } type matrix = { xx : float ; yx : float ; @@ -54,6 +77,15 @@ external create : [> `Any] surface -> t = "ml_cairo_create" external save : t -> unit = "ml_cairo_save" external restore : t -> unit = "ml_cairo_restore" +external _push_group : t -> unit = "ml_cairo_push_group" +external _push_group_with_content : t -> content -> unit = "ml_cairo_push_group_with_content" +let push_group ?content cr = + match content with + | None -> _push_group cr + | Some c -> _push_group_with_content cr c +external pop_group : t -> [`Any] pattern = "ml_cairo_pop_group" +external pop_group_to_source : t -> unit = "ml_cairo_pop_group_to_source" + type operator = OPERATOR_CLEAR @@ -120,6 +152,7 @@ external device_to_user_distance : t -> point -> point = "ml_cairo_device_to_use external new_path : t -> unit = "ml_cairo_new_path" external move_to : t -> x:float -> y:float -> unit = "ml_cairo_move_to" let move_to_point cr { x = x ; y = y } = move_to cr ~x ~y +external new_sub_path : t -> unit = "ml_cairo_new_sub_path" external line_to : t -> x:float -> y:float -> unit = "ml_cairo_line_to" let line_to_point cr { x = x ; y = y } = line_to cr ~x ~y external curve_to : t -> x1:float -> y1:float -> x2:float -> y2:float -> x3:float -> y3:float -> unit = "ml_cairo_curve_to_bc" "ml_cairo_curve_to" @@ -193,6 +226,21 @@ type hint_metrics = | HINT_METRICS_OFF | HINT_METRICS_ON +let font_type_of_int = function + | 0 -> `TOY + | 1 -> `FT + | 2 -> `Win32 + | 3 -> `ATSUI + | _ -> `Any + +external _font_face_get_type : [> `Any] font_face -> int = "ml_cairo_font_face_get_type" +let font_face_get_type f = + font_type_of_int (_font_face_get_type f) +let font_face_downcast_to_toy f = + match font_face_get_type f with + | `TOY -> (Obj.magic f : [`Any|`TOY] font_face) + | _ -> invalid_arg "Cairo: font face downcast" + module Font_Options = struct type t external create : unit -> t = "ml_cairo_font_options_create" @@ -247,6 +295,30 @@ module Font_Options = struct o end +(* scaled fonts *) +module Scaled_Font = struct +type -'a t + +external create : ([>`Any] as 'a) font_face -> matrix -> matrix -> Font_Options.t -> 'a t = "ml_cairo_scaled_font_create" +external _get_type : [> `Any] t -> int = "ml_cairo_scaled_font_get_type" +let get_type f = font_type_of_int (_get_type f) +let downcast_to_toy f = + if get_type f = `TOY + then (Obj.magic f : [`Any|`TOY] t) + else invalid_arg "Cairo: scaled font downcast" +external font_extents : [> `Any] t -> font_extents = "ml_cairo_scaled_font_extents" +external text_extents : [> `Any] t -> string -> text_extents = "ml_cairo_scaled_text_extents" +external glyph_extents : [> `Any] t -> glyph array -> text_extents = "ml_cairo_scaled_font_glyph_extents" +external get_font_face : ([>`Any] as 'a) t -> 'a font_face = "ml_cairo_scaled_font_get_font_face" +external get_font_matrix : ([>`Any] as 'a) t -> matrix = "ml_cairo_scaled_font_get_font_matrix" +external get_ctm : ([>`Any] as 'a) t -> matrix = "ml_cairo_scaled_font_get_ctm" +external _get_font_options : ([>`Any] as 'a) t -> Font_Options.t -> unit = "ml_cairo_scaled_font_get_font_options" +let get_font_options sf = + let o = Font_Options.create () in + _get_font_options sf o ; + o +end + external select_font_face : t -> string -> font_slant -> font_weight -> unit = "ml_cairo_select_font_face" external set_font_size : t -> float -> unit = "ml_cairo_set_font_size" external set_font_matrix : t -> matrix -> unit = "ml_cairo_set_font_matrix" @@ -262,6 +334,7 @@ let get_font_options cr = let o = Font_Options.create () in _get_font_options cr o ; o +external set_scaled_font : t -> [> `Any] Scaled_Font.t -> unit = "ml_cairo_set_scaled_font" external show_text : t -> string -> unit = "ml_cairo_show_text" external show_glyphs : t -> glyph array -> unit = "ml_cairo_show_glyphs" external get_font_face : t -> [`Any] font_face = "ml_cairo_get_font_face" @@ -272,15 +345,6 @@ external glyph_extents : t -> glyph array -> text_extents = "ml_cairo_glyph_exte external text_path : t -> string -> unit = "ml_cairo_text_path" external glyph_path : t -> glyph array -> unit = "ml_cairo_glyph_path" -(* scaled fonts *) -module Scaled_Font = struct -type -'a t - -external create : ([>`Any] as 'a) font_face -> matrix -> matrix -> Font_Options.t -> 'a t = "ml_cairo_scaled_font_create" -external font_extents : [> `Any] t -> font_extents = "ml_cairo_scaled_font_extents" -external glyph_extents : [> `Any] t -> glyph array -> text_extents = "ml_cairo_scaled_font_glyph_extents" -end - external get_operator : t -> operator = "ml_cairo_get_operator" external get_source : t -> [`Any] pattern = "ml_cairo_get_source" external get_tolerance : t -> float = "ml_cairo_get_tolerance" @@ -293,6 +357,7 @@ external get_line_join : t -> line_join = "ml_cairo_get_line_join" external get_miter_limit : t -> float = "ml_cairo_get_miter_limit" external get_matrix : t -> matrix = "ml_cairo_get_matrix" external get_target : t -> [`Any] surface = "ml_cairo_get_target" +external get_group_target : t -> [`Any] surface = "ml_cairo_get_group_target" type flat_path = [ | `MOVE_TO of point @@ -321,15 +386,28 @@ external string_of_status : status -> string = "ml_cairo_status_to_string" (* surface *) -type content = - CONTENT_COLOR - | CONTENT_ALPHA - | CONTENT_COLOR_ALPHA - external surface_create_similar : [> `Any] surface -> content -> width:int -> height:int -> [`Any] surface = "ml_cairo_surface_create_similar" external surface_finish : [> `Any] surface -> unit = "ml_cairo_surface_finish" +external _surface_get_type : [> `Any] surface -> int = "ml_cairo_surface_get_type" +let surface_get_type s = + match _surface_get_type s with + | 0 -> `Image + | 1 -> `PDF + | 2 -> `PS + | 3 -> `Xlib + | 4 -> `XCB + | 5 -> `Glitz + | 6 -> `Quartz + | 7 -> `Win32 + | 8 -> `BeOS + | 9 -> `DirectFB + | 10 -> `SVG + | _ -> `Any + +external surface_get_content : [> `Any] surface -> content = "ml_cairo_surface_get_content" + external _surface_get_font_options : [> `Any] surface -> Font_Options.t -> unit = "ml_cairo_surface_get_font_options" let surface_get_font_options s = let o = Font_Options.create () in @@ -341,6 +419,9 @@ external mark_dirty : [> `Any] surface -> unit = "ml_cairo_surface_mark_dirty external mark_dirty_rectangle : [> `Any] surface -> int -> int -> int -> int -> unit = "ml_cairo_surface_mark_dirty_rectangle" external surface_set_device_offset : [> `Any] surface -> float -> float -> unit = "ml_cairo_surface_set_device_offset" +external surface_get_device_offset : [> `Any] surface -> float * float = "ml_cairo_surface_get_device_offset" + +external surface_set_fallback_resolution : [> `Any] surface -> float -> float -> unit = "ml_cairo_surface_set_fallback_resolution" type image_surface = [`Any|`Image] surface @@ -352,8 +433,10 @@ type format = | FORMAT_A1 external image_surface_create : format -> width:int -> height:int -> image_surface = "ml_cairo_image_surface_create" +external image_surface_get_format : [>`Image] surface -> format = "ml_cairo_image_surface_get_format" external image_surface_get_width : [>`Image] surface -> int = "ml_cairo_image_surface_get_width" external image_surface_get_height : [>`Image] surface -> int = "ml_cairo_image_surface_get_height" +external image_surface_get_stride : [>`Image] surface -> int = "ml_cairo_image_surface_get_stride" @@ -376,6 +459,26 @@ type surface_pattern = [`Any|`Surface] pattern type gradient_pattern = [`Any|`Gradient] pattern module Pattern = struct +external _get_type : [> `Any] pattern -> int = "ml_cairo_pattern_get_type" +let get_type p = + match _get_type p with + | 0 -> `Solid + | 1 -> `Surface + | 2 -> `Linear + | 3 -> `Radial + | _ -> `Any +let downcast_to_solid p = + if get_type p = `Solid + then (Obj.magic p : [`Solid|`Any] pattern) + else invalid_arg "Cairo.Pattern: pattern downcast" +let downcast_to_surface p = + if get_type p = `Surface + then (Obj.magic p : [`Surface|`Any] pattern) + else invalid_arg "Cairo.Pattern: pattern downcast" +let downcast_to_gradient p = + match get_type p with + | `Linear | `Radial -> (Obj.magic p : gradient_pattern) + | _ -> invalid_arg "Cairo.Pattern: pattern downcast" external create_rgb : red:float -> green:float -> blue:float -> solid_pattern = "ml_cairo_pattern_create_rgb" external create_rgba : red:float -> green:float -> blue:float -> alpha:float -> solid_pattern = "ml_cairo_pattern_create_rgba" external create_for_surface : [> `Any] surface -> surface_pattern = "ml_cairo_pattern_create_for_surface" diff --git a/src/cairo.mli b/src/cairo.mli index f097974..5ea1bc3 100644 --- a/src/cairo.mli +++ b/src/cairo.mli @@ -31,6 +31,9 @@ type status = | INVALID_VISUAL | FILE_NOT_FOUND | INVALID_DASH + | INVALID_DSC_COMMENT + | INVALID_INDEX + | CLIP_NOT_REPRESENTABLE exception Error of status val init : unit @@ -49,6 +52,26 @@ type -'a surface type -'a pattern type -'a font_face +type surface_type = [ + | `Image + | `PDF | `PS | `SVG + | `Xlib | `XCB + | `Glitz | `Quartz | `Win32 | `BeOS | `DirectFB ] +type pattern_type = [ + | `Solid + | `Surface + | `Linear | `Radial ] +type font_type = [ + | `TOY + | `FT + | `Win32 + | `ATSUI ] + +type content = + CONTENT_COLOR + | CONTENT_ALPHA + | CONTENT_COLOR_ALPHA + type point = { x : float ; y : float } type matrix = { xx : float ; yx : float ; @@ -62,6 +85,10 @@ val create : [> `Any] surface -> t external save : t -> unit = "ml_cairo_save" external restore : t -> unit = "ml_cairo_restore" +val push_group : ?content:content -> t -> unit +external pop_group : t -> [`Any] pattern = "ml_cairo_pop_group" +external pop_group_to_source : t -> unit = "ml_cairo_pop_group_to_source" + external status : t -> status = "ml_cairo_status" external surface_status : [> `Any] surface -> status = "ml_cairo_surface_status" external pattern_status : [> `Any] pattern -> status = "ml_cairo_pattern_status" @@ -91,9 +118,9 @@ type operator = external set_operator : t -> operator -> unit = "ml_cairo_set_operator" +external set_source : t -> [> `Any] pattern -> unit = "ml_cairo_set_source" external set_source_rgb : t -> red:float -> green:float -> blue:float -> unit = "ml_cairo_set_source_rgb" external set_source_rgba : t -> red:float -> green:float -> blue:float -> alpha:float ->unit = "ml_cairo_set_source_rgba" -external set_source : t -> [> `Any] pattern -> unit = "ml_cairo_set_source" external set_source_surface : t -> [> `Any] surface -> float -> float -> unit = "ml_cairo_set_source_surface" external set_tolerance : t -> float -> unit = "ml_cairo_set_tolerance" @@ -142,6 +169,7 @@ external device_to_user_distance : t -> point -> point = "ml_cairo_device_to_use external new_path : t -> unit = "ml_cairo_new_path" external move_to : t -> x:float -> y:float -> unit = "ml_cairo_move_to" val move_to_point : t -> point -> unit +external new_sub_path : t -> unit = "ml_cairo_new_sub_path" external line_to : t -> x:float -> y:float -> unit = "ml_cairo_line_to" val line_to_point : t -> point -> unit external curve_to : t -> x1:float -> y1:float -> x2:float -> y2:float -> x3:float -> y3:float -> unit = "ml_cairo_curve_to_bc" "ml_cairo_curve_to" @@ -173,9 +201,9 @@ external in_fill : t -> point -> bool = "ml_cairo_in_fill" external stroke_extents : t -> float * float * float * float = "ml_cairo_stroke_extents" external fill_extents : t -> float * float * float * float = "ml_cairo_fill_extents" +external reset_clip : t -> unit = "ml_cairo_reset_clip" external clip : t -> unit = "ml_cairo_clip" external clip_preserve : t -> unit = "ml_cairo_clip_preserve" -external reset_clip : t -> unit = "ml_cairo_reset_clip" (** {3 Text API} *) @@ -219,6 +247,9 @@ type hint_metrics = | HINT_METRICS_OFF | HINT_METRICS_ON +val font_face_get_type : [> `Any] font_face -> [font_type|`Any] +val font_face_downcast_to_toy : [> `Any] font_face -> [`Any|`TOY] font_face + (** {4 Font options} *) (** Font options functions *) @@ -256,6 +287,25 @@ module Font_Options : sig val make : [< all] list -> t end +(** {4 Scaled Fonts API} *) + +(** Scaled fonts functions *) +module Scaled_Font : sig +type -'a t + +external create : ([>`Any] as 'a) font_face -> matrix -> matrix -> Font_Options.t -> 'a t = "ml_cairo_scaled_font_create" +val get_type : [> `Any] t -> [font_type|`Any] +val downcast_to_toy : [> `Any] t -> [`Any|`TOY] t +external font_extents : [> `Any] t -> font_extents = "ml_cairo_scaled_font_extents" +external text_extents : [> `Any] t -> string -> text_extents = "ml_cairo_scaled_text_extents" +external glyph_extents : [>`Any] t -> glyph array -> text_extents = "ml_cairo_scaled_font_glyph_extents" +external get_font_face : ([>`Any] as 'a) t -> 'a font_face = "ml_cairo_scaled_font_get_font_face" +external get_font_matrix : ([>`Any] as 'a) t -> matrix = "ml_cairo_scaled_font_get_font_matrix" +external get_ctm : ([>`Any] as 'a) t -> matrix = "ml_cairo_scaled_font_get_ctm" +val get_font_options : ([>`Any] as 'a) t -> Font_Options.t +end + + external select_font_face : t -> string -> font_slant -> font_weight -> unit = "ml_cairo_select_font_face" external set_font_size : t -> float -> unit = "ml_cairo_set_font_size" external set_font_matrix : t -> matrix -> unit = "ml_cairo_set_font_matrix" @@ -263,6 +313,7 @@ external get_font_matrix : t -> matrix = "ml_cairo_get_font_matrix" external set_font_options : t -> Font_Options.t -> unit = "ml_cairo_set_font_matrix" val merge_font_options : t -> Font_Options.t -> unit val get_font_options : t -> Font_Options.t +external set_scaled_font : t -> [> `Any] Scaled_Font.t -> unit = "ml_cairo_set_scaled_font" external show_text : t -> string -> unit = "ml_cairo_show_text" external show_glyphs : t -> glyph array -> unit = "ml_cairo_show_glyphs" external get_font_face : t -> [`Any] font_face = "ml_cairo_get_font_face" @@ -273,17 +324,6 @@ external glyph_extents : t -> glyph array -> text_extents = "ml_cairo_glyph_exte external text_path : t -> string -> unit = "ml_cairo_text_path" external glyph_path : t -> glyph array -> unit = "ml_cairo_glyph_path" -(** {4 Scaled Fonts API} *) - -(** Scaled fonts functions *) -module Scaled_Font : sig -type -'a t - -external create : ([>`Any] as 'a) font_face -> matrix -> matrix -> Font_Options.t -> 'a t = "ml_cairo_scaled_font_create" -external font_extents : [> `Any] t -> font_extents = "ml_cairo_scaled_font_extents" -external glyph_extents : [>`Any] t -> glyph array -> text_extents = "ml_cairo_scaled_font_glyph_extents" -end - (** {3 Renderer state querying} *) external get_operator : t -> operator = "ml_cairo_get_operator" @@ -298,6 +338,7 @@ external get_line_join : t -> line_join = "ml_cairo_get_line_join" external get_miter_limit : t -> float = "ml_cairo_get_miter_limit" external get_matrix : t -> matrix = "ml_cairo_get_matrix" external get_target : t -> [`Any] surface = "ml_cairo_get_target" +external get_group_target : t -> [`Any] surface = "ml_cairo_get_group_target" type flat_path = [ | `MOVE_TO of point @@ -313,15 +354,13 @@ val append_path : t -> [< path] -> unit (** {3 Surface API} *) -type content = - CONTENT_COLOR - | CONTENT_ALPHA - | CONTENT_COLOR_ALPHA - external surface_create_similar : [> `Any] surface -> content -> width:int -> height:int -> [`Any] surface = "ml_cairo_surface_create_similar" external surface_finish : [> `Any] surface -> unit = "ml_cairo_surface_finish" +val surface_get_type : [> `Any] surface -> [surface_type | `Any] +external surface_get_content : [> `Any] surface -> content = "ml_cairo_surface_get_content" + val surface_get_font_options : [> `Any] surface -> Font_Options.t external surface_flush : [> `Any] surface -> unit = "ml_cairo_surface_flush" @@ -329,6 +368,9 @@ external mark_dirty : [> `Any] surface -> unit = "ml_cairo_surface_mark_dirty external mark_dirty_rectangle : [> `Any] surface -> int -> int -> int -> int -> unit = "ml_cairo_surface_mark_dirty_rectangle" external surface_set_device_offset : [> `Any] surface -> float -> float -> unit = "ml_cairo_surface_set_device_offset" +external surface_get_device_offset : [> `Any] surface -> float * float = "ml_cairo_surface_get_device_offset" + +external surface_set_fallback_resolution : [> `Any] surface -> float -> float -> unit = "ml_cairo_surface_set_fallback_resolution" (** {4 Image surface} *) @@ -341,8 +383,10 @@ type format = | FORMAT_A1 external image_surface_create : format -> width:int -> height:int -> image_surface = "ml_cairo_image_surface_create" -external image_surface_get_width : [>`Image] surface -> int = "ml_cairo_image_surface_get_width" -external image_surface_get_height : [>`Image] surface -> int = "ml_cairo_image_surface_get_height" +external image_surface_get_format : [>`Image] surface -> format = "ml_cairo_image_surface_get_format" +external image_surface_get_width : [>`Image] surface -> int = "ml_cairo_image_surface_get_width" +external image_surface_get_height : [>`Image] surface -> int = "ml_cairo_image_surface_get_height" +external image_surface_get_stride : [>`Image] surface -> int = "ml_cairo_image_surface_get_stride" (** {3 Patterns} *) @@ -365,6 +409,10 @@ type filter = (** Patterns functions *) module Pattern : sig +val get_type : [> `Any] pattern -> [pattern_type|`Any] +val downcast_to_solid : [> `Any] pattern -> solid_pattern +val downcast_to_surface : [> `Any] pattern -> surface_pattern +val downcast_to_gradient : [> `Any] pattern -> gradient_pattern external create_rgb : red:float -> green:float -> blue:float -> solid_pattern = "ml_cairo_pattern_create_rgb" external create_rgba : red:float -> green:float -> blue:float -> alpha:float -> solid_pattern = "ml_cairo_pattern_create_rgba" external create_for_surface : [> `Any] surface -> surface_pattern = "ml_cairo_pattern_create_for_surface" diff --git a/src/cairo_ft.ml b/src/cairo_ft.ml index 3b27b59..be2f0af 100644 --- a/src/cairo_ft.ml +++ b/src/cairo_ft.ml @@ -27,5 +27,14 @@ type font_face = [`Any|`FT] Cairo.font_face external font_face_create_for_pattern : fc_pattern -> font_face = "ml_cairo_ft_font_face_create_for_pattern" external font_face_create_for_ft_face : ft_face -> int -> font_face = "ml_cairo_ft_font_face_create_for_ft_face" +let downcast_font_face f = + match Cairo.font_face_get_type f with + | `FT -> (Obj.magic f : font_face) + | _ -> invalid_arg "Cairo_ft: font face downcast" +let downcast_scaled_font sf = + match Cairo.Scaled_Font.get_type sf with + | `FT -> (Obj.magic sf : [`Any|`FT] Cairo.Scaled_Font.t) + | _ -> invalid_arg "Cairo_ft: scaled font downcast" + external font_lock_face : [> `FT] Cairo.Scaled_Font.t -> ft_face = "ml_cairo_ft_scaled_font_lock_face" external font_unlock_face : [> `FT] Cairo.Scaled_Font.t -> unit = "ml_cairo_ft_scaled_font_unlock_face" diff --git a/src/cairo_ft.mli b/src/cairo_ft.mli index d10c399..de17396 100644 --- a/src/cairo_ft.mli +++ b/src/cairo_ft.mli @@ -29,6 +29,7 @@ external fc_name_parse : cairo_ft_font_options_substitute, FcDefaultSubstitute and FcFontMatch *) external fc_name_unparse : fc_pattern -> string = "ml_FcNameUnparse" +(* font_options_substitute *) type font_face = [`Any|`FT] Cairo.font_face @@ -37,5 +38,8 @@ external font_face_create_for_pattern : fc_pattern -> font_face external font_face_create_for_ft_face : ft_face -> int -> font_face = "ml_cairo_ft_font_face_create_for_ft_face" +val downcast_font_face : [> `Any] Cairo.font_face -> font_face +val downcast_scaled_font : [> `Any] Cairo.Scaled_Font.t -> [`Any|`FT] Cairo.Scaled_Font.t + external font_lock_face : [>`FT] Cairo.Scaled_Font.t -> ft_face = "ml_cairo_ft_scaled_font_lock_face" external font_unlock_face : [>`FT] Cairo.Scaled_Font.t -> unit = "ml_cairo_ft_scaled_font_unlock_face" diff --git a/src/cairo_pdf.ml b/src/cairo_pdf.ml index f0e8370..b7e0c66 100644 --- a/src/cairo_pdf.ml +++ b/src/cairo_pdf.ml @@ -13,10 +13,9 @@ external surface_create_for_stream_unsafe : width_in_points:float -> height_in_points:float -> surface = "ml_cairo_pdf_surface_create_for_stream_unsafe" +external unsafe_output : out_channel -> string -> int -> int -> unit = "caml_ml_output" let unsafe_output_string oc s n = - for i = 0 to n - 1 do - output_char oc (String.unsafe_get s i) - done + unsafe_output oc s 0 n let surface_create_for_channel oc ~width_in_points ~height_in_points = surface_create_for_stream_unsafe @@ -27,5 +26,5 @@ external surface_create_for_stream : width_in_points:float -> height_in_points:float -> surface = "ml_cairo_pdf_surface_create_for_stream" -external set_dpi : - [> `PDF] Cairo.surface -> x_dpi:float -> y_dpi:float -> unit = "ml_cairo_pdf_surface_set_dpi" +external set_size : + [> `PDF] Cairo.surface -> width_in_points:float -> height_in_points:float -> unit = "ml_cairo_pdf_surface_set_size" diff --git a/src/cairo_pdf.mli b/src/cairo_pdf.mli index d17034b..bdea342 100644 --- a/src/cairo_pdf.mli +++ b/src/cairo_pdf.mli @@ -20,5 +20,5 @@ external surface_create_for_stream : width_in_points:float -> height_in_points:float -> surface = "ml_cairo_pdf_surface_create_for_stream" -external set_dpi : - [> `PDF] Cairo.surface -> x_dpi:float -> y_dpi:float -> unit = "ml_cairo_pdf_surface_set_dpi" +external set_size : + [> `PDF] Cairo.surface -> width_in_points:float -> height_in_points:float -> unit = "ml_cairo_pdf_surface_set_size" diff --git a/src/cairo_ps.ml b/src/cairo_ps.ml index 01448ea..6095b06 100644 --- a/src/cairo_ps.ml +++ b/src/cairo_ps.ml @@ -13,10 +13,9 @@ external surface_create_for_stream_unsafe : width_in_points:float -> height_in_points:float -> surface = "ml_cairo_ps_surface_create_for_stream_unsafe" +external unsafe_output : out_channel -> string -> int -> int -> unit = "caml_ml_output" let unsafe_output_string oc s n = - for i = 0 to n - 1 do - output_char oc (String.unsafe_get s i) - done + unsafe_output oc s 0 n let surface_create_for_channel oc ~width_in_points ~height_in_points = surface_create_for_stream_unsafe @@ -27,5 +26,9 @@ external surface_create_for_stream : width_in_points:float -> height_in_points:float -> surface = "ml_cairo_ps_surface_create_for_stream" -external set_dpi : - [> `PS] Cairo.surface -> x_dpi:float -> y_dpi:float -> unit = "ml_cairo_ps_surface_set_dpi" +external set_size : + [> `PS] Cairo.surface -> width_in_points:float -> height_in_points:float -> unit = "ml_cairo_ps_surface_set_size" + +external dsc_comment : [> `PS] Cairo.surface -> string -> unit = "ml_cairo_ps_surface_dsc_comment" +external scb_begin_setup : [> `PS] Cairo.surface -> unit = "ml_cairo_ps_surface_dsc_begin_setup" +external scb_begin_page_setup : [> `PS] Cairo.surface -> unit = "ml_cairo_ps_surface_dsc_begin_page_setup" diff --git a/src/cairo_ps.mli b/src/cairo_ps.mli index 1f0f709..e269dec 100644 --- a/src/cairo_ps.mli +++ b/src/cairo_ps.mli @@ -20,5 +20,5 @@ external surface_create_for_stream : width_in_points:float -> height_in_points:float -> surface = "ml_cairo_ps_surface_create_for_stream" -external set_dpi : - [> `PS] Cairo.surface -> x_dpi:float -> y_dpi:float -> unit = "ml_cairo_ps_surface_set_dpi" +external set_size : + [> `PS] Cairo.surface -> width_in_points:float -> height_in_points:float -> unit = "ml_cairo_ps_surface_set_size" diff --git a/src/cairo_svg.ml b/src/cairo_svg.ml index 9f665f4..22f5e0d 100644 --- a/src/cairo_svg.ml +++ b/src/cairo_svg.ml @@ -27,5 +27,11 @@ external surface_create_for_stream : 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" +type version = + | VERSION_1_1 + | VERSION_1_2 + +external restrict_to_version : + [> `SVG] Cairo.surface -> version -> unit = "ml_cairo_svg_surface_restrict_to_version" + +external string_of_version : version -> string = "ml_cairo_svg_version_to_string" diff --git a/src/cairo_svg.mli b/src/cairo_svg.mli index 42d1977..90d3d68 100644 --- a/src/cairo_svg.mli +++ b/src/cairo_svg.mli @@ -20,5 +20,11 @@ external surface_create_for_stream : 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" +type version = + | VERSION_1_1 + | VERSION_1_2 + +external restrict_to_version : + [> `SVG] Cairo.surface -> version -> unit = "ml_cairo_svg_surface_restrict_to_version" + +external string_of_version : version -> string = "ml_cairo_svg_version_to_string" diff --git a/src/ml_cairo.c b/src/ml_cairo.c index d6e77a1..ad5fbaa 100644 --- a/src/ml_cairo.c +++ b/src/ml_cairo.c @@ -46,24 +46,33 @@ wML_0_cairo(save) wML_0_cairo(restore) +wML_0_cairo(push_group) +wML_1_cairo(push_group_with_content, cairo_content_t_val) +CAMLprim value +ml_cairo_pop_group (value cr) +{ + cairo_pattern_t *p = cairo_pop_group (cairo_t_val (cr)); + check_cairo_status (cr); + return Val_cairo_pattern_t (p); +} +wML_0_cairo(pop_group_to_source) + + #define cairo_operator_t_val(v) ((cairo_operator_t) Int_val(v)) #define Val_cairo_operator_t(v) Val_int(v) wML_1_cairo(set_operator, cairo_operator_t_val) +wML_1_cairo(set_source, cairo_pattern_t_val) + wML_3_cairo(set_source_rgb, Double_val, Double_val, Double_val) wML_4_cairo(set_source_rgba, Double_val, Double_val, Double_val, Double_val) -wML_1_cairo(set_source, cairo_pattern_t_val) - wML_3_cairo(set_source_surface, cairo_surface_t_val, Double_val, Double_val) wML_1_cairo(set_tolerance, Double_val) -#define cairo_antialias_t_val(v) ((cairo_antialias_t) Int_val(v)) -#define Val_cairo_antialias_t(v) Val_int(v) - wML_1_cairo(set_antialias, cairo_antialias_t_val) #define cairo_fill_rule_t_val(v) ((cairo_fill_rule_t) Int_val(v)) @@ -197,6 +206,8 @@ wML_0_cairo(new_path) wML_2_cairo(move_to, Double_val, Double_val) +wML_0_cairo(new_sub_path) + wML_2_cairo(line_to, Double_val, Double_val) wML_6_cairo(curve_to, Double_val, Double_val, Double_val, Double_val, Double_val, Double_val) @@ -291,13 +302,12 @@ ml_cairo_fill_extents (value v_cr) } } +wML_0_cairo(reset_clip) + wML_0_cairo(clip) wML_0_cairo(clip_preserve) -wML_0_cairo(reset_clip) - - #define cairo_font_weight_t_val(v) ((cairo_font_weight_t) Int_val(v)) #define Val_cairo_font_weight_t(v) Val_int(v) @@ -342,6 +352,8 @@ ml_cairo_get_font_matrix (value v_cr) wML_1_cairo (set_font_options, cairo_font_options_t_val) wML_1_cairo (get_font_options, cairo_font_options_t_val) +wML_1_cairo (set_scaled_font, cairo_scaled_font_t_val) + wML_1_cairo(show_text, String_val) cairo_glyph_t * @@ -492,6 +504,8 @@ ml_cairo_get_matrix (value v_cr) cairo_get(target, Val_cairo_surface_ref) +cairo_get(group_target, Val_cairo_surface_ref) + /* ml_cairo_path */ /* ml_cairo_status */ @@ -571,12 +585,3 @@ ml_cairo_unsafe_read_func (void *closure, unsigned char *data, unsigned int leng } return CAIRO_STATUS_SUCCESS; } - - - -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) diff --git a/src/ml_cairo.h b/src/ml_cairo.h index f307f57..443a359 100644 --- a/src/ml_cairo.h +++ b/src/ml_cairo.h @@ -36,6 +36,10 @@ value Val_cairo_pattern_t (cairo_pattern_t *); #define cairo_format_t_val(v) ((cairo_format_t) Int_val(v)) #define Val_cairo_format_t(v) Val_int(v) +#define cairo_antialias_t_val(v) ((cairo_antialias_t) Int_val(v)) +#define Val_cairo_antialias_t(v) Val_int(v) + +/* cairo_font */ #define cairo_font_face_t_val(v) wPointer_val(cairo_font_face_t, v) value Val_cairo_font_face_t (cairo_font_face_t *); #define Val_cairo_font_face_ref(p) Val_cairo_font_face_t (cairo_font_face_reference(p)) @@ -46,10 +50,14 @@ value Val_cairo_scaled_font_t (cairo_scaled_font_t *); #define cairo_font_options_t_val(v) wPointer_val(cairo_font_options_t, v) value Val_cairo_font_options_t (cairo_font_options_t *); +/* cairo_surface */ +cairo_content_t cairo_content_t_val (value); + + /* cairo_matrix */ #ifdef ARCH_ALIGN_DOUBLE void ml_convert_cairo_matrix_in (value, cairo_matrix_t *); -value ml_convert_cairo_matrix_out (cairo_matrix_t *); +value ml_convert_cairo_matrix_out (const cairo_matrix_t *); #else # define cairo_matrix_t_val(v) (cairo_matrix_t *)(v) # define cairo_matrix_alloc() caml_alloc_small (6 * Double_wosize, Double_array_tag) diff --git a/src/ml_cairo_bigarr.c b/src/ml_cairo_bigarr.c index 7f8e802..27f3850 100644 --- a/src/ml_cairo_bigarr.c +++ b/src/ml_cairo_bigarr.c @@ -48,3 +48,5 @@ ml_cairo_image_surface_create_for_data (value img, value fmt, value w, value h, return Val_cairo_surface_t (surf); } + +/* cairo_image_surface_get_data */ diff --git a/src/ml_cairo_font.c b/src/ml_cairo_font.c index ac715de..bdad3ec 100644 --- a/src/ml_cairo_font.c +++ b/src/ml_cairo_font.c @@ -8,17 +8,16 @@ #include "ml_cairo.h" -wMake_Val_final_pointer(cairo_font_face_t, cairo_font_face_destroy, 0) - -wMake_Val_final_pointer(cairo_scaled_font_t, cairo_scaled_font_destroy, 0) + +/* cairo_font_options */ +static long +ml_cairo_font_options_hash (value fo) +{ + return cairo_font_options_hash (cairo_font_options_t_val (fo)); +} -wMake_Val_final_pointer(cairo_font_options_t, cairo_font_options_destroy, 0) -/* XXX: could be using cairo_font_options_equal and cairo_font_options_hash here ... */ - -/* font_face_reference */ -/* font_face_destroy */ -/* font_face_get_user_data */ -/* font_face_set_user_data */ +wMake_Val_final_pointer_full(cairo_font_options_t, cairo_font_options_destroy, 0, \ + ml_pointer_compare, ml_cairo_font_options_hash) CAMLprim value ml_cairo_font_options_create (value unit) @@ -29,15 +28,42 @@ ml_cairo_font_options_create (value unit) } wML_2(cairo_font_options_merge, cairo_font_options_t_val, cairo_font_options_t_val, Unit) -wML_2(cairo_font_options_set_antialias, cairo_font_options_t_val, Long_val, Unit) -wML_1(cairo_font_options_get_antialias, cairo_font_options_t_val, Val_long) -wML_2(cairo_font_options_set_subpixel_order, cairo_font_options_t_val, Long_val, Unit) -wML_1(cairo_font_options_get_subpixel_order, cairo_font_options_t_val, Val_long) -wML_2(cairo_font_options_set_hint_style, cairo_font_options_t_val, Long_val, Unit) -wML_1(cairo_font_options_get_hint_style, cairo_font_options_t_val, Val_long) -wML_2(cairo_font_options_set_hint_metrics, cairo_font_options_t_val, Long_val, Unit) -wML_1(cairo_font_options_get_hint_metrics, cairo_font_options_t_val, Val_long) +wML_2(cairo_font_options_equal, cairo_font_options_t_val, cairo_font_options_t_val, Val_bool) +#define cairo_subpixel_order_t_val(v) ((cairo_subpixel_order_t) Int_val(v)) +#define Val_cairo_subpixel_order_t(v) Val_int(v) +#define cairo_hint_style_t_val(v) ((cairo_hint_style_t) Int_val(v)) +#define Val_cairo_hint_style_t(v) Val_int(v) +#define cairo_hint_metrics_t_val(v) ((cairo_hint_metrics_t) Int_val(v)) +#define Val_cairo_hint_metrics_t(v) Val_int(v) + +wML_2(cairo_font_options_set_antialias, cairo_font_options_t_val, cairo_antialias_t_val, Unit) +wML_1(cairo_font_options_get_antialias, cairo_font_options_t_val, Val_cairo_antialias_t) +wML_2(cairo_font_options_set_subpixel_order, cairo_font_options_t_val, cairo_subpixel_order_t_val, Unit) +wML_1(cairo_font_options_get_subpixel_order, cairo_font_options_t_val, Val_cairo_subpixel_order_t) +wML_2(cairo_font_options_set_hint_style, cairo_font_options_t_val, cairo_hint_style_t_val, Unit) +wML_1(cairo_font_options_get_hint_style, cairo_font_options_t_val, Val_cairo_hint_style_t) +wML_2(cairo_font_options_set_hint_metrics, cairo_font_options_t_val, cairo_hint_metrics_t_val, Unit) +wML_1(cairo_font_options_get_hint_metrics, cairo_font_options_t_val, Val_cairo_hint_metrics_t) + + + +/* cairo_font_face */ +wMake_Val_final_pointer(cairo_font_face_t, cairo_font_face_destroy, 0) +/* font_face_reference */ +/* font_face_destroy */ +/* font_face_status */ + +#define Val_cairo_font_type_t(v) Val_int(v) +wML_1(cairo_font_face_get_type, cairo_font_face_t_val, Val_cairo_font_type_t) + +/* font_face_get_user_data */ +/* font_face_set_user_data */ + + + +/* cairo_scaled_font */ +wMake_Val_final_pointer(cairo_scaled_font_t, cairo_scaled_font_destroy, 0) CAMLprim value ml_cairo_scaled_font_create (value f, value fmat, value ctm, value fo) @@ -61,6 +87,9 @@ ml_cairo_scaled_font_create (value f, value fmat, value ctm, value fo) /* scaled_font_face_reference */ /* scaled_font_face_destroy */ +/* scaled_font_face_status */ + +wML_1 (cairo_scaled_font_get_type, cairo_scaled_font_t_val, Val_cairo_font_type_t) CAMLprim value ml_cairo_scaled_font_extents (value sf) @@ -72,6 +101,15 @@ ml_cairo_scaled_font_extents (value sf) } CAMLprim value +ml_scaled_font_text_extents (value sf, value v_utf8) +{ + cairo_text_extents_t c_extents; + cairo_scaled_font_text_extents (cairo_scaled_font_t_val (sf), String_val (v_utf8), &c_extents); + cairo_treat_status (cairo_scaled_font_status (cairo_scaled_font_t_val (sf))); + return Val_cairo_text_extents (&c_extents); +} + +CAMLprim value ml_cairo_scaled_font_glyph_extents (value sf, value v_glyphs) { int num_glyphs; @@ -81,5 +119,46 @@ ml_cairo_scaled_font_glyph_extents (value sf, value v_glyphs) cairo_scaled_font_glyph_extents (cairo_scaled_font_t_val (sf), c_glyphs, num_glyphs, &c_extents); caml_stat_free (c_glyphs); + cairo_treat_status (cairo_scaled_font_status (cairo_scaled_font_t_val (sf))); return Val_cairo_text_extents (&c_extents); } + +wML_1 (cairo_scaled_font_get_font_face, cairo_scaled_font_t_val, Val_cairo_font_face_ref) + +CAMLprim value +ml_cairo_scaled_font_get_font_matrix (value sf) +{ + CAMLparam1(sf); + CAMLlocal1(m); +#ifndef ARCH_ALIGN_DOUBLE + m = cairo_matrix_alloc(); + cairo_scaled_font_get_font_matrix (cairo_scaled_font_t_val (sf), + cairo_matrix_t_val (m)); +#else + cairo_matrix_t c_m; + cairo_scaled_font_get_font_matrix (cairo_scaled_font_t_val (sf), &c_m); + m = ml_convert_cairo_matrix_out (c_m); +#endif + cairo_treat_status (cairo_scaled_font_status (cairo_scaled_font_t_val (sf))); + CAMLreturn(m); +} + +CAMLprim value +ml_cairo_scaled_font_get_ctm (value sf) +{ + CAMLparam1(sf); + CAMLlocal1(m); +#ifndef ARCH_ALIGN_DOUBLE + m = cairo_matrix_alloc(); + cairo_scaled_font_get_ctm (cairo_scaled_font_t_val (sf), + cairo_matrix_t_val (m)); +#else + cairo_matrix_t c_m; + cairo_scaled_font_get_ctm (cairo_scaled_font_t_val (sf), &c_m); + m = ml_convert_cairo_matrix_out (c_m); +#endif + cairo_treat_status (cairo_scaled_font_status (cairo_scaled_font_t_val (sf))); + CAMLreturn(m); +} + +wML_2 (cairo_scaled_font_get_font_options, cairo_scaled_font_t_val, cairo_font_options_t_val, Unit) diff --git a/src/ml_cairo_ft.c b/src/ml_cairo_ft.c index 916817a..f8d5727 100644 --- a/src/ml_cairo_ft.c +++ b/src/ml_cairo_ft.c @@ -113,6 +113,7 @@ ml_FcNameUnparse (value patt) /* cairo Fontconfig/Freetype font backend */ wML_1 (cairo_ft_font_face_create_for_pattern, FcPattern_val, Val_cairo_font_face_t) +wML_2 (cairo_ft_font_options_substitute, cairo_font_options_t_val, FcPattern_val, Unit) wML_2 (cairo_ft_font_face_create_for_ft_face, FT_Face_val, Int_val, Val_cairo_font_face_t) wML_1 (cairo_ft_scaled_font_lock_face, cairo_scaled_font_t_val, Val_ptr) wML_1 (cairo_ft_scaled_font_unlock_face, cairo_scaled_font_t_val, Unit) @@ -126,6 +127,7 @@ Unsupported (ml_FT_Done_Face) Unsupported (ml_FcNameParse) Unsupported (ml_FcNameUnparse) Unsupported (ml_cairo_ft_font_create_for_pattern) +Unsupported (ml_cairo_ft_font_options_substitute) Unsupported (ml_cairo_ft_font_create_for_ft_face) Unsupported (ml_cairo_ft_scaled_font_lock_face) Unsupported (ml_cairo_ft_scaled_font_unlock_face) diff --git a/src/ml_cairo_lablgtk.c b/src/ml_cairo_lablgtk.c index 338433f..0a27e60 100644 --- a/src/ml_cairo_lablgtk.c +++ b/src/ml_cairo_lablgtk.c @@ -16,190 +16,6 @@ #include "ml_gdkpixbuf.h" #include "ml_gdk.h" - -#if ! GTK_CHECK_VERSION(2,8,0) -/* For "old" versions of GTK+, provide the GTK+/cairo integration, - (stolen from GTK+) -*/ -#include <gdk/gdkx.h> -#ifdef CAIRO_HAS_XLIB_SURFACE -# include <cairo-xlib.h> -#else -# error "Cairo was not compiled with support for the xlib backend" -#endif - -static cairo_t * -gdk_cairo_create (GdkDrawable *target) -{ - int width, height; - int x_off=0, y_off=0; - cairo_t *cr; - cairo_surface_t *surface; - GdkDrawable *drawable = target; - GdkVisual *visual; - - g_return_val_if_fail (GDK_IS_DRAWABLE (drawable), NULL); - - if (GDK_IS_WINDOW(target)) { - /* query the window's backbuffer if it has one */ - GdkWindow *window = GDK_WINDOW(target); - gdk_window_get_internal_paint_info (window, - &drawable, &x_off, &y_off); - } - visual = gdk_drawable_get_visual (drawable); - gdk_drawable_get_size (drawable, &width, &height); - - if (visual) { - surface = cairo_xlib_surface_create (GDK_DRAWABLE_XDISPLAY (drawable), - GDK_DRAWABLE_XID (drawable), - GDK_VISUAL_XVISUAL (visual), - width, height); - } else if (gdk_drawable_get_depth (drawable) == 1) { - surface = cairo_xlib_surface_create_for_bitmap - (GDK_PIXMAP_XDISPLAY (drawable), - GDK_PIXMAP_XID (drawable), - GDK_SCREEN_XSCREEN (gdk_drawable_get_screen (drawable)), - width, height); - } else { - g_warning ("Using Cairo rendering requires the drawable argument to\n" - "have a specified colormap. All windows have a colormap,\n" - "however, pixmaps only have colormap by default if they\n" - "were created with a non-NULL window argument. Otherwise\n" - "a colormap must be set on them with " - "gdk_drawable_set_colormap"); - return NULL; - } - cairo_surface_set_device_offset (surface, -x_off, -y_off); - - cr = cairo_create (surface); - cairo_surface_destroy (surface); - - return cr; -} - -static void -gdk_cairo_set_source_color (cairo_t *cr, - GdkColor *color) -{ - g_return_if_fail (cr != NULL); - g_return_if_fail (color != NULL); - - cairo_set_source_rgb (cr, - color->red / 65535., - color->green / 65535., - color->blue / 65535.); -} - -static void -gdk_cairo_rectangle (cairo_t *cr, - GdkRectangle *rectangle) -{ - g_return_if_fail (cr != NULL); - g_return_if_fail (rectangle != NULL); - - cairo_rectangle (cr, - rectangle->x, rectangle->y, - rectangle->width, rectangle->height); -} - -static void -gdk_cairo_region (cairo_t *cr, - GdkRegion *region) -{ - caml_failwith("Cairo_lablgtk.region is unsupported with this version of GTK+"); -} - -static void -gdk_cairo_set_source_pixbuf (cairo_t *cr, - GdkPixbuf *pixbuf, - double pixbuf_x, - double pixbuf_y) -{ - gint width = gdk_pixbuf_get_width (pixbuf); - gint height = gdk_pixbuf_get_height (pixbuf); - guchar *gdk_pixels = gdk_pixbuf_get_pixels (pixbuf); - int gdk_rowstride = gdk_pixbuf_get_rowstride (pixbuf); - int n_channels = gdk_pixbuf_get_n_channels (pixbuf); - guchar *cairo_pixels; - cairo_format_t format; - cairo_surface_t *surface; - static const cairo_user_data_key_t key; - int j; - - if (n_channels == 3) - format = CAIRO_FORMAT_RGB24; - else - format = CAIRO_FORMAT_ARGB32; - - cairo_pixels = g_malloc (4 * width * height); - surface = cairo_image_surface_create_for_data ((unsigned char *)cairo_pixels, - format, - width, height, 4 * width); - cairo_surface_set_user_data (surface, &key, - cairo_pixels, (cairo_destroy_func_t)g_free); - - for (j = height; j; j--) - { - guchar *p = gdk_pixels; - guchar *q = cairo_pixels; - - if (n_channels == 3) - { - guchar *end = p + 3 * width; - - while (p < end) - { -#if G_BYTE_ORDER == G_LITTLE_ENDIAN - q[0] = p[2]; - q[1] = p[1]; - q[2] = p[0]; -#else - q[1] = p[0]; - q[2] = p[1]; - q[3] = p[2]; -#endif - p += 3; - q += 4; - } - } - else - { - guchar *end = p + 4 * width; - guint t1,t2,t3; - -#define MULT(d,c,a,t) G_STMT_START { t = c * a; d = ((t >> 8) + t) >> 8; } G_STMT_END - - while (p < end) - { -#if G_BYTE_ORDER == G_LITTLE_ENDIAN - MULT(q[0], p[2], p[3], t1); - MULT(q[1], p[1], p[3], t2); - MULT(q[2], p[0], p[3], t3); - q[3] = p[3]; -#else - q[0] = p[3]; - MULT(q[1], p[0], p[3], t1); - MULT(q[2], p[1], p[3], t2); - MULT(q[3], p[2], p[3], t3); -#endif - - p += 4; - q += 4; - } - -#undef MULT - } - - gdk_pixels += gdk_rowstride; - cairo_pixels += 4 * width; - } - - cairo_set_source_surface (cr, surface, pixbuf_x, pixbuf_y); - cairo_surface_destroy (surface); -} - -#endif /* GTK_CHECK_VERSION(2,8,0) */ - wML_1(gdk_cairo_create, GdkDrawable_val, Val_cairo_t) wML_2(gdk_cairo_set_source_color, cairo_t_val, GdkColor_val, Unit) wML_2(gdk_cairo_rectangle, cairo_t_val, GdkRectangle_val, Unit) diff --git a/src/ml_cairo_matrix.c b/src/ml_cairo_matrix.c index 97ed2f2..17ecff5 100644 --- a/src/ml_cairo_matrix.c +++ b/src/ml_cairo_matrix.c @@ -21,7 +21,7 @@ ml_convert_cairo_matrix_in (value v, cairo_matrix_t *mat) } value -ml_convert_cairo_matrix_out (cairo_matrix_t *mat) +ml_convert_cairo_matrix_out (const cairo_matrix_t *mat) { value v; v = caml_alloc_small (6 * Double_wosize, Double_array_tag); diff --git a/src/ml_cairo_path.c b/src/ml_cairo_path.c index ecff731..5b348e7 100644 --- a/src/ml_cairo_path.c +++ b/src/ml_cairo_path.c @@ -8,10 +8,10 @@ #include "ml_cairo.h" -#define CAML_MOVE_TO_TAG 0x95006a53L -#define CAML_LINE_TO_TAG 0x3f23e04dL -#define CAML_CLOSE_TAG 0x8ca29f31L -#define CAML_CURVE_TO_TAG 0x84e3bcd7L +#define CAML_MOVE_TO_TAG -1795134893L +#define CAML_LINE_TO_TAG 1059315789L +#define CAML_CLOSE_TAG -1110065659L +#define CAML_CURVE_TO_TAG -2065449769L static value ml_cairo_fold_path (cairo_path_t *path, value f, value acc) diff --git a/src/ml_cairo_pattern.c b/src/ml_cairo_pattern.c index c60b1ca..6581fbf 100644 --- a/src/ml_cairo_pattern.c +++ b/src/ml_cairo_pattern.c @@ -61,6 +61,9 @@ wML_bc6(cairo_pattern_create_radial) /* pattern_reference */ /* pattern_destroy */ +#define Val_cairo_pattern_type_t(v) Val_int(v) +wML_1(cairo_pattern_get_type, cairo_pattern_t_val, Val_cairo_pattern_type_t) + wML_4_cairo(pattern_add_color_stop_rgb, Double_val, Double_val, Double_val, Double_val) wML_5_cairo(pattern_add_color_stop_rgba, Double_val, Double_val, Double_val, Double_val, Double_val) diff --git a/src/ml_cairo_pdf.c b/src/ml_cairo_pdf.c index 23416c4..eec2ccb 100644 --- a/src/ml_cairo_pdf.c +++ b/src/ml_cairo_pdf.c @@ -39,12 +39,12 @@ ml_cairo_pdf_surface_create_for_stream (value f, value w, value h) return _ml_cairo_pdf_surface_create_for_stream (f, w, h, 0); } -wML_3(cairo_pdf_surface_set_dpi, cairo_surface_t_val, Double_val, Double_val, Unit) +wML_3(cairo_pdf_surface_set_size, cairo_surface_t_val, Double_val, Double_val, Unit) #else Cairo_Unsupported(cairo_pdf_surface_create_for_stream_unsafe, "PDF backend not supported"); Cairo_Unsupported(cairo_pdf_surface_create_for_stream, "PDF backend not supported"); -Cairo_Unsupported(cairo_pdf_surface_set_dpi, "PDF backend not supported"); +Cairo_Unsupported(cairo_pdf_surface_set_size, "PDF backend not supported"); #endif diff --git a/src/ml_cairo_ps.c b/src/ml_cairo_ps.c index 2340ce3..8757617 100644 --- a/src/ml_cairo_ps.c +++ b/src/ml_cairo_ps.c @@ -39,12 +39,18 @@ ml_cairo_ps_surface_create_for_stream (value f, value w, value h) return _ml_cairo_ps_surface_create_for_stream (f, w, h, 0); } -wML_3(cairo_ps_surface_set_dpi, cairo_surface_t_val, Double_val, Double_val, Unit) +wML_3(cairo_ps_surface_set_size, cairo_surface_t_val, Double_val, Double_val, Unit) + +wML_2(cairo_ps_surface_dsc_comment, cairo_surface_t_val, String_val, Unit) +wML_1(cairo_ps_surface_dsc_begin_setup, cairo_surface_t_val, Unit) +wML_1(cairo_ps_surface_dsc_begin_page_setup, cairo_surface_t_val, Unit) #else Cairo_Unsupported(cairo_ps_surface_create_for_stream_unsafe, "PS backend not supported"); Cairo_Unsupported(cairo_ps_surface_create_for_stream, "PS backend not supported"); -Cairo_Unsupported(cairo_ps_surface_set_dpi, "PS backend not supported"); - +Cairo_Unsupported(cairo_ps_surface_set_size, "PS backend not supported"); +Cairo_Unsupported(cairo_ps_surface_dsc_comment, "PS backend not supported"); +Cairo_Unsupported(cairo_ps_surface_dsc_begin_setup, "PS backend not supported"); +Cairo_Unsupported(cairo_ps_surface_dsc_begin_page_setup, "PS backend not supported"); #endif diff --git a/src/ml_cairo_surface.c b/src/ml_cairo_surface.c index cb9c992..1b35895 100644 --- a/src/ml_cairo_surface.c +++ b/src/ml_cairo_surface.c @@ -10,7 +10,7 @@ wMake_Val_final_pointer(cairo_surface_t, cairo_surface_destroy, 0) -static cairo_content_t +cairo_content_t cairo_content_t_val (value v) { switch (Long_val (v)) @@ -22,6 +22,18 @@ cairo_content_t_val (value v) } } +value +Val_cairo_content_t (cairo_content_t c) +{ + switch (c) + { + case CAIRO_CONTENT_COLOR : return Val_long(0); + case CAIRO_CONTENT_ALPHA : return Val_long(1); + case CAIRO_CONTENT_COLOR_ALPHA: return Val_long(2); + default: assert(0); + } +} + wML_4(cairo_surface_create_similar, \ cairo_surface_t_val, cairo_content_t_val, \ Int_val, Int_val, Val_cairo_surface_t) @@ -37,6 +49,10 @@ ml_cairo_surface_finish (value surf) return Val_unit; } +#define Val_cairo_surface_type_t(v) Val_int(v) +wML_1 (cairo_surface_get_type, cairo_surface_t_val, Val_cairo_surface_type_t) +wML_1 (cairo_surface_get_content, cairo_surface_t_val, Val_cairo_content_t) + static void ml_cairo_destroy_user_data (void *data) { @@ -94,3 +110,30 @@ wML_1(cairo_surface_mark_dirty, cairo_surface_t_val, Unit) wML_5(cairo_surface_mark_dirty_rectangle, cairo_surface_t_val, Int_val, Int_val, Int_val, Int_val, Unit) wML_3(cairo_surface_set_device_offset, cairo_surface_t_val, Double_val, Double_val, Unit) +CAMLprim value +ml_cairo_surface_get_device_offset (value s) +{ + double x, y; + CAMLparam1(s); + CAMLlocal1(v); + cairo_surface_get_device_offset (cairo_surface_t_val(s), &x, &y); + v = caml_alloc_tuple(2); + Store_field(v, 0, caml_copy_double(x)); + Store_field(v, 1, caml_copy_double(y)); + CAMLreturn (v); +} + +wML_3(cairo_surface_set_fallback_resolution, cairo_surface_t_val, Double_val, Double_val, Unit) + + +/* Image surface */ +wML_3(cairo_image_surface_create, cairo_format_t_val, Int_val, Int_val, Val_cairo_surface_t) + +/* cairo_image_surface_create_for_data -> in ml_cairo_bigarr.c */ +/* cairo_image_surface_get_data -> in ml_cairo_bigarr.c */ + +wML_1 (cairo_image_surface_get_format, cairo_surface_t_val, Val_cairo_format_t) +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) +wML_1 (cairo_image_surface_get_stride, cairo_surface_t_val, Val_int) + diff --git a/src/ml_cairo_svg.c b/src/ml_cairo_svg.c index 2f21b1d..a11f442 100644 --- a/src/ml_cairo_svg.c +++ b/src/ml_cairo_svg.c @@ -39,12 +39,18 @@ 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) +#define cairo_svg_version_t_val(v) ((cairo_svg_version_t) Int_val(v)) +#define Val_cairo_svg_version_t(v) Val_int(v) + +wML_2(cairo_svg_surface_restrict_to_version, cairo_surface_t_val, cairo_svg_version_t_val, Unit) +/* cairo_svg_get_versions */ +wML_1(cairo_svg_version_to_string, cairo_svg_version_t_val, caml_copy_string) #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"); +Cairo_Unsupported(cairo_svg_surface_restrict_to_version, "SVG backend not supported"); +Cairo_Unsupported(cairo_svg_version_to_string, "SVG backend not supported"); #endif diff --git a/src/ml_cairo_wrappers.h b/src/ml_cairo_wrappers.h index eb2ffc7..827bca7 100644 --- a/src/ml_cairo_wrappers.h +++ b/src/ml_cairo_wrappers.h @@ -11,13 +11,13 @@ int ml_pointer_compare (value, value); long ml_pointer_hash (value); -#define wMake_Val_final_pointer(type, final, adv) \ +#define wMake_Val_final_pointer_full(type, final, adv, cmp_method, hash_method) \ static void ml_final_##type (value val) \ { type **p = Data_custom_val(val); \ if (*p) final (*p); } \ static struct custom_operations ml_custom_##type = \ { #type "/001", ml_final_##type, \ - ml_pointer_compare, ml_pointer_hash, \ + cmp_method, hash_method, \ custom_serialize_default, custom_deserialize_default }; \ value Val_##type (type *p) \ { type **store; value ret; \ @@ -26,6 +26,8 @@ value Val_##type (type *p) \ store = Data_custom_val(ret); \ *store = p; return ret; } +#define wMake_Val_final_pointer(type, final, adv) wMake_Val_final_pointer_full(type, final, adv, ml_pointer_compare, ml_pointer_hash) + #ifndef ARCH_ALIGN_DOUBLE #define Double_array_val(v) ((double *)(v)) #endif |