summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorOlivier Andrieu <oandrieu@gmail.com>2006-11-08 23:42:34 +0000
committerHezekiah M. Carty <hcarty@atmos.umd.edu>2009-06-18 14:01:38 -0400
commit7bb5641a396cb618399c2dcae304051ad952d86b (patch)
treeae3a76ab24b08495d311b39ea2175eb81021ab1a
parent14f6316fd8c180def30f42d6120e68d2e4654c13 (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--ChangeLog6
-rw-r--r--configure.ac4
-rw-r--r--src/cairo.ml131
-rw-r--r--src/cairo.mli88
-rw-r--r--src/cairo_ft.ml9
-rw-r--r--src/cairo_ft.mli4
-rw-r--r--src/cairo_pdf.ml9
-rw-r--r--src/cairo_pdf.mli4
-rw-r--r--src/cairo_ps.ml13
-rw-r--r--src/cairo_ps.mli4
-rw-r--r--src/cairo_svg.ml10
-rw-r--r--src/cairo_svg.mli10
-rw-r--r--src/ml_cairo.c39
-rw-r--r--src/ml_cairo.h10
-rw-r--r--src/ml_cairo_bigarr.c2
-rw-r--r--src/ml_cairo_font.c115
-rw-r--r--src/ml_cairo_ft.c2
-rw-r--r--src/ml_cairo_lablgtk.c184
-rw-r--r--src/ml_cairo_matrix.c2
-rw-r--r--src/ml_cairo_path.c8
-rw-r--r--src/ml_cairo_pattern.c3
-rw-r--r--src/ml_cairo_pdf.c4
-rw-r--r--src/ml_cairo_ps.c12
-rw-r--r--src/ml_cairo_surface.c45
-rw-r--r--src/ml_cairo_svg.c10
-rw-r--r--src/ml_cairo_wrappers.h6
26 files changed, 445 insertions, 289 deletions
diff --git a/ChangeLog b/ChangeLog
index 827ee5a..29f7b2b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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