From f4c136dd1a73babdb57485aaca430912f854a842 Mon Sep 17 00:00:00 2001 From: Arthur Wendling Date: Tue, 9 Dec 2014 11:33:34 +0100 Subject: [PATCH 01/31] Add a cairo2 renderer to the build system --- _tags | 4 +++- build | 2 +- opam | 1 + pkg/META | 11 +++++++++++ pkg/build.ml | 2 ++ src/vgr_cairo2.ml | 23 +++++++++++++++++++++++ src/vgr_cairo2.mli | 14 ++++++++++++++ src/vgr_cairo2.mllib | 1 + 8 files changed, 56 insertions(+), 2 deletions(-) create mode 100644 src/vgr_cairo2.ml create mode 100644 src/vgr_cairo2.mli create mode 100644 src/vgr_cairo2.mllib diff --git a/_tags b/_tags index fe7919b..1af964a 100644 --- a/_tags +++ b/_tags @@ -12,6 +12,8 @@ : package(gg), package(uutf), package(otfm) +: package(gg), package(cairo2) + : package(gg) : package(uutf) @@ -42,4 +44,4 @@ : package(gg) : package(gg), package(uutf), package(otfm) - : package(gg), package(uutf), package(otfm) \ No newline at end of file + : package(gg), package(uutf), package(otfm) diff --git a/build b/build index 0469bf6..376d4c4 100755 --- a/build +++ b/build @@ -11,7 +11,7 @@ OCAMLBUILD=${OCAMLBUILD:="ocamlbuild -tag debug -classic-display \ action () { case $1 in - default) $OCAMLBUILD vg.cmx vgr_pdf.cmx vgr_svg.cmx vgr_htmlc.cmx ;; + default) $OCAMLBUILD vg.cmx vgr_pdf.cmx vgr_svg.cmx vgr_htmlc.cmx vgr_cairo2.cmx ;; tests) $OCAMLBUILD rpdf.native rsvg.native; action rhtmlc ;; rhtmlc) shift; pkg/db-locs diff --git a/opam b/opam index 681c3a3..6e6be18 100644 --- a/opam +++ b/opam @@ -17,5 +17,6 @@ build: "native-dynlink=%{ocaml-native-dynlink}%" "uutf=%{uutf:installed}%" "otfm=%{otfm:installed}%" + "cairo2=%{cairo2:installed}%" "jsoo=%{js_of_ocaml:installed}%" ] ] diff --git a/pkg/META b/pkg/META index 1f9d554..9db2140 100644 --- a/pkg/META +++ b/pkg/META @@ -39,3 +39,14 @@ package "htmlc" ( archive(native, plugin) = "vgr_htmlc.cmxs" exists_if = "vgr_htmlc.cma" ) + +package "cairo2" ( + version = "%%VERSION%%" + description = "Vg's Cairo2 renderer" + requires = "vg cairo2" + archive(byte) = "vgr_cairo2.cma" + archive(byte, plugin) = "vgr_cairo2.cma" + archive(native) = "vgr_cairo2.cmxa" + archive(native, plugin) = "vgr_cairo2.cmxs" + exists_if = "vgr_cairo2.cma" +) diff --git a/pkg/build.ml b/pkg/build.ml index 3fd87e8..435c398 100755 --- a/pkg/build.ml +++ b/pkg/build.ml @@ -6,6 +6,7 @@ let uutf = Env.bool "uutf" let otfm = Env.bool "otfm" let jsoo = Env.bool "jsoo" let vgr_pdf = uutf && otfm +let cairo2 = Env.bool "cairo2" let () = Pkg.describe "vg" ~builder:`OCamlbuild [ Pkg.lib "pkg/META"; @@ -14,6 +15,7 @@ let () = Pkg.describe "vg" ~builder:`OCamlbuild [ Pkg.lib ~cond:vgr_pdf ~exts:Exts.module_library "src/vgr_pdf"; Pkg.bin ~cond:vgr_pdf ~auto:true "test/vecho"; Pkg.lib ~cond:jsoo ~exts:Exts.module_library "src/vgr_htmlc"; + Pkg.lib ~cond:cairo2 ~exts:Exts.module_library "src/vgr_cairo2"; Pkg.doc "README.md"; Pkg.doc "CHANGES.md"; Pkg.doc "test/min_htmlc.html"; diff --git a/src/vgr_cairo2.ml b/src/vgr_cairo2.ml new file mode 100644 index 0000000..8bdb546 --- /dev/null +++ b/src/vgr_cairo2.ml @@ -0,0 +1,23 @@ +(*--------------------------------------------------------------------------- + Distributed under the BSD3 license, see license at the end of the file. + %%NAME%% release %%VERSION%% + ---------------------------------------------------------------------------*) + +open Gg +open Vg +open Vgr.Private.Data + +type state = unit + +let render s v k r = match v with +| `End -> k r +| `Image (size, view, i) -> + failwith "todo" + +let target surface = + let target r _ = + let ctx = Cairo.create surface in + let state = () in + true, render state + in + Vgr.Private.create_target target diff --git a/src/vgr_cairo2.mli b/src/vgr_cairo2.mli new file mode 100644 index 0000000..3a0f1c2 --- /dev/null +++ b/src/vgr_cairo2.mli @@ -0,0 +1,14 @@ +(*--------------------------------------------------------------------------- + Distributed under the BSD3 license, see license at the end of the file. + %%NAME%% release %%VERSION%% + ---------------------------------------------------------------------------*) + +(** Vg Cairo2 renderer. + + {b References.} + {ul {- {e {{:http://forge.ocamlcore.org/projects/cairo/}Cairo2 library + for OCaml}}}} + + {e Release %%VERSION%% — %%MAINTAINER%% } *) + +val target : Cairo.Surface.t -> [`Other] Vg.Vgr.target diff --git a/src/vgr_cairo2.mllib b/src/vgr_cairo2.mllib new file mode 100644 index 0000000..9365b41 --- /dev/null +++ b/src/vgr_cairo2.mllib @@ -0,0 +1 @@ +Vgr_cairo2 From 501d6f723f3e822d7c720ef7f93ef0ae6de9e8d4 Mon Sep 17 00:00:00 2001 From: Arthur Wendling Date: Tue, 9 Dec 2014 11:34:54 +0100 Subject: [PATCH 02/31] Add a minimal cairo2 example --- test/min_cairo2.ml | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) create mode 100644 test/min_cairo2.ml diff --git a/test/min_cairo2.ml b/test/min_cairo2.ml new file mode 100644 index 0000000..02bc00b --- /dev/null +++ b/test/min_cairo2.ml @@ -0,0 +1,29 @@ +(* This code is in the public domain. + + Minimal Vgr_cairo2 example. Compile with: + + ocamlfind ocamlc \ + -package cairo2 \ + -package gg,vg,vg.cairo2 \ + -linkpkg -o min_cairo2.byte min_cairo2.ml +*) + +open Gg +open Vg + +(* 1. Define your image *) + +let aspect = 1.618 +let size = Size2.v (aspect *. 100.) 100. (* mm *) +let view = Box2.v P2.o (Size2.v aspect 1.) +let image = I.const (Color.v_srgb 0.314 0.784 0.471) + +(* 2. Render *) + +let () = + let surface = Cairo.Image.create Cairo.Image.ARGB32 100 100 in + let warn w = Vgr.pp_warning Format.err_formatter w in + let r = Vgr.create ~warn (Vgr_cairo2.target surface) `Other in + ignore (Vgr.render r (`Image (size, view, image))); + ignore (Vgr.render r `End); + Cairo.PNG.write surface "min_cairo2.png" From 70ee9825549f039f8e4aa62dc650b69ef01e554a Mon Sep 17 00:00:00 2001 From: Arthur Wendling Date: Tue, 9 Dec 2014 12:02:15 +0100 Subject: [PATCH 03/31] Vgr_cairo2: cost semantics --- src/vgr_cairo2.ml | 35 ++++++++++++++++++++++++++++++++--- 1 file changed, 32 insertions(+), 3 deletions(-) diff --git a/src/vgr_cairo2.ml b/src/vgr_cairo2.ml index 8bdb546..b5e0ec9 100644 --- a/src/vgr_cairo2.ml +++ b/src/vgr_cairo2.ml @@ -7,17 +7,46 @@ open Gg open Vg open Vgr.Private.Data -type state = unit +type cmd = Draw of Vgr.Private.Data.image +type state = + { r : Vgr.Private.renderer; (* corresponding renderer. *) + surface : Cairo.Surface.t; (* surface rendered to. *) + ctx : Cairo.context; (* context of [surface]. *) + mutable cost : int; (* cost counter for limit. *) + mutable todo : cmd list; (* commands to perform. *) + } + +let partial = Vgr.Private.partial +let limit s = Vgr.Private.limit s.r +let warn s w = Vgr.Private.warn s.r w +let image i = Vgr.Private.I.of_data i + +let rec r_image s k r = + if s.cost > limit s then (s.cost <- 0; partial (r_image s k) r) else + match s.todo with + | [] -> k r + | Draw i :: todo -> + s.cost <- s.cost + 1; + match i with + | _ -> + s.todo <- todo; + r_image s k r let render s v k r = match v with | `End -> k r | `Image (size, view, i) -> - failwith "todo" + s.cost <- 0; + s.todo <- [ Draw i ]; + r_image s k r let target surface = let target r _ = let ctx = Cairo.create surface in - let state = () in + let state = + { r; surface; ctx; + cost = 0; + todo = []; + } in true, render state in Vgr.Private.create_target target From b8adbaa24f7fd7fb7c6f622e1b0e1978de7c03f2 Mon Sep 17 00:00:00 2001 From: Arthur Wendling Date: Tue, 9 Dec 2014 13:29:53 +0100 Subject: [PATCH 04/31] Vgr_cairo2: subset implementation based on Vgr_htmlc --- src/vgr_cairo2.ml | 224 +++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 210 insertions(+), 14 deletions(-) diff --git a/src/vgr_cairo2.ml b/src/vgr_cairo2.ml index b5e0ec9..0bb033d 100644 --- a/src/vgr_cairo2.ml +++ b/src/vgr_cairo2.ml @@ -1,4 +1,5 @@ (*--------------------------------------------------------------------------- + Copyright 2013 Daniel C. Bünzli. All rights reserved. Distributed under the BSD3 license, see license at the end of the file. %%NAME%% release %%VERSION%% ---------------------------------------------------------------------------*) @@ -7,46 +8,241 @@ open Gg open Vg open Vgr.Private.Data -type cmd = Draw of Vgr.Private.Data.image +type cairo_primitive = + | Color of Color.t +type gstate = (* subset of the graphics state saved by a Cairo.save ctx *) + { mutable g_tr : M3.t; (* current transform without view_tr. *) + mutable g_outline : P.outline; (* current outline stroke. *) + mutable g_stroke : cairo_primitive; (* current stroke color. *) + mutable g_fill : cairo_primitive; } (* current fill color. *) + +let dumb_prim = Color (Color.v 0.0 0.0 0.0 0.0) + +let init_gstate = + { g_tr = M3.id; g_outline = P.o; g_stroke = dumb_prim; g_fill = dumb_prim } + +type cmd = Set of gstate | Draw of Vgr.Private.Data.image type state = - { r : Vgr.Private.renderer; (* corresponding renderer. *) - surface : Cairo.Surface.t; (* surface rendered to. *) - ctx : Cairo.context; (* context of [surface]. *) - mutable cost : int; (* cost counter for limit. *) - mutable todo : cmd list; (* commands to perform. *) - } + { r : Vgr.Private.renderer; (* corresponding renderer. *) + surface : Cairo.Surface.t; (* surface rendered to. *) + ctx : Cairo.context; (* context of [surface]. *) + mutable cost : int; (* cost counter for limit. *) + mutable view : Gg.box2; (* current renderable view rectangle. *) + mutable view_tr : M3.t; (* view to canvas transform. *) + mutable todo : cmd list; (* commands to perform. *) + prims : (* cached primitives. *) + (Vgr.Private.Data.primitive, cairo_primitive) Hashtbl.t; + mutable gstate : gstate; } (* current graphic state. *) + +let save_gstate s = Set { s.gstate with g_tr = s.gstate.g_tr } +let set_gstate s g = s.gstate <- g let partial = Vgr.Private.partial let limit s = Vgr.Private.limit s.r let warn s w = Vgr.Private.warn s.r w let image i = Vgr.Private.I.of_data i +let view_rect s = (* image view rect in current coordinate system. *) + let tr = M3.inv s.gstate.g_tr in + Vgr.Private.Data.of_path (P.empty >> P.rect (Box2.tr tr s.view)) + +let cairo_matrix xx yx xy yy x0 y0 = + { Cairo.xx; yx; xy; yy; x0; y0 } + +let cairo_matrix_of_m3 m = + M3.(cairo_matrix (e00 m) (e10 m) (e01 m) (e11 m) (e02 m) (e12 m)) + +let cairo_cap = function + | `Butt -> Cairo.BUTT + | `Round -> Cairo.ROUND + | `Square -> Cairo.SQUARE + +let cairo_join = function + | `Bevel -> Cairo.JOIN_BEVEL + | `Round -> Cairo.JOIN_ROUND + | `Miter -> Cairo.JOIN_MITER + +let cairo_fill_rule = function + | `Anz -> Cairo.WINDING + | `Aeo -> Cairo.EVEN_ODD + | `O _ -> assert false + +let init_ctx s = + let o = s.gstate.g_outline in + let m = s.view_tr in + Cairo.transform s.ctx (cairo_matrix_of_m3 m); + Cairo.set_line_width s.ctx o.P.width; + Cairo.set_line_cap s.ctx (cairo_cap o.P.cap); + Cairo.set_line_join s.ctx (cairo_join o.P.join); + Cairo.set_miter_limit s.ctx (Vgr.Private.P.miter_limit o); + (*set_dashes ~warning:false s o.P.dashes*) + () + +let push_transform s tr = + let m = match tr with + | Move v -> Cairo.translate s.ctx (V2.x v) (V2.y v); M3.move2 v + | Rot a -> Cairo.rotate s.ctx a; M3.rot2 a + | Scale sv -> Cairo.scale s.ctx (V2.x sv) (V2.y sv); M3.scale2 sv + | Matrix m -> Cairo.transform s.ctx (cairo_matrix_of_m3 m); m + in + s.gstate.g_tr <- M3.mul s.gstate.g_tr m + +let set_outline s o = + if s.gstate.g_outline == o then () else + let old = s.gstate.g_outline in + s.gstate.g_outline <- o; + if old.P.width <> o.P.width then (Cairo.set_line_width s.ctx o.P.width); + if old.P.cap <> o.P.cap then (Cairo.set_line_cap s.ctx (cairo_cap o.P.cap)); + if old.P.join <> o.P.join then (Cairo.set_line_join s.ctx (cairo_join o.P.join)); + if old.P.miter_angle <> o.P.miter_angle then + (Cairo.set_miter_limit s.ctx (Vgr.Private.P.miter_limit o)); + (*if old.P.dashes <> o.P.dashes then set_dashes s o.P.dashes;*) + () + +let get_primitive s p = try Hashtbl.find s.prims p with +| Not_found -> + let create = function + | Const c -> Color c + | _ -> failwith "todo" + in + let js_prim = create p in + Hashtbl.add s.prims p js_prim; js_prim + +let set_stroke s p = + failwith "todo" + +let set_fill s p = + let p = get_primitive s p in + if s.gstate.g_fill != p then begin match p with + | Color c -> + Color.(Cairo.set_source_rgba s.ctx (r c) (g c) (b c) (a c)); + s.gstate.g_fill <- p + end + +let set_path s p = + let rec loop last = function + | [] -> () + | seg :: segs -> + match seg with + | `Sub pt -> P2.(Cairo.move_to s.ctx (x pt) (y pt)); loop pt segs + | `Line pt -> P2.(Cairo.line_to s.ctx (x pt) (y pt)); loop pt segs + | `Qcurve (c, pt) -> + failwith "todo"; + loop pt segs + | `Ccurve (c, c', pt) -> + P2.(Cairo.curve_to s.ctx (x c) (y c) (x c') (y c') (x pt) (y pt)); + loop pt segs + | `Earc (large, cw, r, a, pt) -> + begin match Vgr.Private.P.earc_params last large cw r a pt with + | None -> P2.(Cairo.line_to s.ctx (x pt) (y pt)); loop pt segs + | Some (c, m, a, a') -> + Cairo.save s.ctx; + let c = V2.ltr (M2.inv m) c in + M2.(Cairo.transform s.ctx (cairo_matrix (e00 m) (e10 m) (e01 m) (e11 m) 0. 0.)); + let arc = if cw then Cairo.arc else Cairo.arc_negative in + P2.(arc s.ctx (x c) (y c) 1.0 a a'); + Cairo.restore s.ctx; + loop pt segs + end + | `Close -> Cairo.Path.close s.ctx; loop last (* we don't care *) segs + in + Cairo.Path.clear s.ctx; + loop P2.o (List.rev p) + +let rec r_cut s a = function +| Primitive (Raster _) -> assert false +| Primitive p -> + begin match a with + | `O o -> set_outline s o; set_stroke s p; Cairo.stroke s.ctx + | `Aeo | `Anz -> + set_fill s p; + Cairo.set_fill_rule s.ctx (cairo_fill_rule a); + Cairo.fill s.ctx + end +| Tr (tr, i) -> + Cairo.save s.ctx; + s.todo <- (save_gstate s) :: s.todo; + push_transform s tr; + r_cut s a i +| Blend _ | Cut _ | Cut_glyphs _ as i -> + let a = match a with + | `O _ -> warn s (`Unsupported_cut (a, image i)); `Anz + | a -> a + in + Cairo.save s.ctx; + Cairo.set_fill_rule s.ctx (cairo_fill_rule a); + Cairo.clip s.ctx; + s.todo <- (Draw i) :: (save_gstate s) :: s.todo + let rec r_image s k r = if s.cost > limit s then (s.cost <- 0; partial (r_image s k) r) else match s.todo with | [] -> k r + | Set gs :: todo -> + Printf.printf "r_image: set\n%!" ; + Cairo.restore s.ctx; + set_gstate s gs; + s.todo <- todo; + r_image s k r | Draw i :: todo -> + Printf.printf "r_image: draw\n%!" ; s.cost <- s.cost + 1; match i with - | _ -> + | Primitive _ as i -> (* Uncut primitive, just cut to view. *) + let p = view_rect s in + s.todo <- (Draw (Cut (`Anz, p, i))) :: todo; + r_image s k r + | Cut (a, p, i) -> + s.todo <- todo; + set_path s p; + r_cut s a i; + r_image s k r + | Cut_glyphs (a, run, i) -> s.todo <- todo; + failwith "todo" + (*r_cut_glyphs s a run i;*) + r_image s k r + | Blend (_, _, i, i') -> + s.todo <- (Draw i') :: (Draw i) :: todo; + r_image s k r + | Tr (tr, i) -> + Cairo.save s.ctx; + s.todo <- (Draw i) :: (save_gstate s) :: todo; + push_transform s tr; r_image s k r let render s v k r = match v with | `End -> k r | `Image (size, view, i) -> + let cw = float (Cairo.Image.get_width s.surface) in + let ch = float (Cairo.Image.get_height s.surface) in + (* Map view rect (bot-left coords) to surface (top-left coords) *) + let sx = cw /. Box2.w view in + let sy = ch /. Box2.h view in + let dx = -. Box2.ox view *. sx in + let dy = ch +. Box2.oy view *. sy in + let view_tr = M3.v sx 0. dx + 0. (-. sy) dy + 0. 0. 1. + in s.cost <- 0; + s.view <- view; + s.view_tr <- view_tr; s.todo <- [ Draw i ]; + s.gstate <- { init_gstate with g_tr = init_gstate.g_tr }; (* copy *) + init_ctx s; + Printf.printf "starting to work\n%!" ; r_image s k r let target surface = let target r _ = let ctx = Cairo.create surface in - let state = - { r; surface; ctx; - cost = 0; - todo = []; - } in - true, render state + true, render { r; surface; ctx; + cost = 0; + view = Box2.empty; + view_tr = M3.id; + todo = []; + prims = Hashtbl.create 231; + gstate = init_gstate; } in Vgr.Private.create_target target From 84325556eaa311d8c4f5fe768b5f1004adae7a4c Mon Sep 17 00:00:00 2001 From: Arthur Wendling Date: Wed, 10 Dec 2014 00:53:00 +0100 Subject: [PATCH 05/31] Vgr_cairo2: stroke and dash --- src/vgr_cairo2.ml | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/src/vgr_cairo2.ml b/src/vgr_cairo2.ml index 0bb033d..8d74305 100644 --- a/src/vgr_cairo2.ml +++ b/src/vgr_cairo2.ml @@ -67,6 +67,12 @@ let cairo_fill_rule = function | `Aeo -> Cairo.EVEN_ODD | `O _ -> assert false +let set_dashes s = function + | None -> Cairo.set_dash s.ctx [||] + | Some (offset, dashes) -> + let dashes = Array.of_list dashes in + Cairo.set_dash s.ctx ~ofs:offset dashes + let init_ctx s = let o = s.gstate.g_outline in let m = s.view_tr in @@ -75,8 +81,7 @@ let init_ctx s = Cairo.set_line_cap s.ctx (cairo_cap o.P.cap); Cairo.set_line_join s.ctx (cairo_join o.P.join); Cairo.set_miter_limit s.ctx (Vgr.Private.P.miter_limit o); - (*set_dashes ~warning:false s o.P.dashes*) - () + set_dashes s o.P.dashes let push_transform s tr = let m = match tr with @@ -96,7 +101,7 @@ let set_outline s o = if old.P.join <> o.P.join then (Cairo.set_line_join s.ctx (cairo_join o.P.join)); if old.P.miter_angle <> o.P.miter_angle then (Cairo.set_miter_limit s.ctx (Vgr.Private.P.miter_limit o)); - (*if old.P.dashes <> o.P.dashes then set_dashes s o.P.dashes;*) + if old.P.dashes <> o.P.dashes then set_dashes s o.P.dashes; () let get_primitive s p = try Hashtbl.find s.prims p with @@ -109,7 +114,12 @@ let get_primitive s p = try Hashtbl.find s.prims p with Hashtbl.add s.prims p js_prim; js_prim let set_stroke s p = - failwith "todo" + let p = get_primitive s p in + if s.gstate.g_stroke != p then begin match p with + | Color c -> + Color.(Cairo.set_source_rgba s.ctx (r c) (g c) (b c) (a c)); + s.gstate.g_stroke <- p + end let set_fill s p = let p = get_primitive s p in From a07a50ef8cb51ae0f62ae72a23c6ae115c0e1144 Mon Sep 17 00:00:00 2001 From: Arthur Wendling Date: Wed, 10 Dec 2014 01:35:33 +0100 Subject: [PATCH 06/31] Vgr_cairo2: gradients --- src/vgr_cairo2.ml | 52 +++++++++++++++++++++++++---------------------- 1 file changed, 28 insertions(+), 24 deletions(-) diff --git a/src/vgr_cairo2.ml b/src/vgr_cairo2.ml index 8d74305..cb9d33d 100644 --- a/src/vgr_cairo2.ml +++ b/src/vgr_cairo2.ml @@ -8,16 +8,16 @@ open Gg open Vg open Vgr.Private.Data -type cairo_primitive = - | Color of Color.t +type cairo_primitive = Pattern : 'a Cairo.Pattern.t -> cairo_primitive + +let dumb_prim = Pattern (Cairo.Pattern.create_rgba 0.0 0.0 0.0 0.0) + type gstate = (* subset of the graphics state saved by a Cairo.save ctx *) { mutable g_tr : M3.t; (* current transform without view_tr. *) mutable g_outline : P.outline; (* current outline stroke. *) mutable g_stroke : cairo_primitive; (* current stroke color. *) mutable g_fill : cairo_primitive; } (* current fill color. *) -let dumb_prim = Color (Color.v 0.0 0.0 0.0 0.0) - let init_gstate = { g_tr = M3.id; g_outline = P.o; g_stroke = dumb_prim; g_fill = dumb_prim } @@ -106,28 +106,35 @@ let set_outline s o = let get_primitive s p = try Hashtbl.find s.prims p with | Not_found -> + let add_stop g (t, c) = + Cairo.Pattern.add_color_stop_rgba g ~ofs:t + (Color.r c) (Color.g c) (Color.b c) (Color.a c) in let create = function - | Const c -> Color c - | _ -> failwith "todo" + | Const c -> + Pattern Color.(Cairo.Pattern.create_rgba (r c) (g c) (b c) (a c)) + | Axial (stops, pt, pt') -> + let g = V2.(Cairo.Pattern.create_linear (x pt) (y pt) (x pt') (y pt')) in + List.iter (add_stop g) stops; Pattern g + | Radial (stops, f, c, r) -> + let g = V2.(Cairo.Pattern.create_radial + ~x0:(x f) ~y0:(y f) ~x1:(x c) ~y1:(y c) ~r0:0.0 ~r1:r) in + List.iter (add_stop g) stops; Pattern g + | Raster _ -> assert false in - let js_prim = create p in - Hashtbl.add s.prims p js_prim; js_prim + let prim = create p in + Hashtbl.add s.prims p prim; prim -let set_stroke s p = +let set_source s p = let p = get_primitive s p in if s.gstate.g_stroke != p then begin match p with - | Color c -> - Color.(Cairo.set_source_rgba s.ctx (r c) (g c) (b c) (a c)); - s.gstate.g_stroke <- p - end + | Pattern g -> Cairo.set_source s.ctx g + end; + p + +let set_stroke s p = s.gstate.g_stroke <- set_source s p + +let set_fill s p = s.gstate.g_fill <- set_source s p -let set_fill s p = - let p = get_primitive s p in - if s.gstate.g_fill != p then begin match p with - | Color c -> - Color.(Cairo.set_source_rgba s.ctx (r c) (g c) (b c) (a c)); - s.gstate.g_fill <- p - end let set_path s p = let rec loop last = function @@ -150,7 +157,7 @@ let set_path s p = let c = V2.ltr (M2.inv m) c in M2.(Cairo.transform s.ctx (cairo_matrix (e00 m) (e10 m) (e01 m) (e11 m) 0. 0.)); let arc = if cw then Cairo.arc else Cairo.arc_negative in - P2.(arc s.ctx (x c) (y c) 1.0 a a'); + P2.(arc s.ctx ~x:(x c) ~y:(y c) ~r:1.0 ~a1:a ~a2:a'); Cairo.restore s.ctx; loop pt segs end @@ -189,13 +196,11 @@ let rec r_image s k r = match s.todo with | [] -> k r | Set gs :: todo -> - Printf.printf "r_image: set\n%!" ; Cairo.restore s.ctx; set_gstate s gs; s.todo <- todo; r_image s k r | Draw i :: todo -> - Printf.printf "r_image: draw\n%!" ; s.cost <- s.cost + 1; match i with | Primitive _ as i -> (* Uncut primitive, just cut to view. *) @@ -241,7 +246,6 @@ let render s v k r = match v with s.todo <- [ Draw i ]; s.gstate <- { init_gstate with g_tr = init_gstate.g_tr }; (* copy *) init_ctx s; - Printf.printf "starting to work\n%!" ; r_image s k r let target surface = From 9df466ee782d9985d190ecd179fecd73fb6cd48f Mon Sep 17 00:00:00 2001 From: Arthur Wendling Date: Wed, 10 Dec 2014 17:40:31 +0100 Subject: [PATCH 07/31] Vgr_cairo2: glyphs --- src/vgr_cairo2.ml | 60 +++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 58 insertions(+), 2 deletions(-) diff --git a/src/vgr_cairo2.ml b/src/vgr_cairo2.ml index cb9d33d..a73a1f7 100644 --- a/src/vgr_cairo2.ml +++ b/src/vgr_cairo2.ml @@ -8,6 +8,7 @@ open Gg open Vg open Vgr.Private.Data +type cairo_font = Font : 'a Cairo.Font_face.t -> cairo_font type cairo_primitive = Pattern : 'a Cairo.Pattern.t -> cairo_primitive let dumb_prim = Pattern (Cairo.Pattern.create_rgba 0.0 0.0 0.0 0.0) @@ -30,6 +31,7 @@ type state = mutable view : Gg.box2; (* current renderable view rectangle. *) mutable view_tr : M3.t; (* view to canvas transform. *) mutable todo : cmd list; (* commands to perform. *) + fonts : (Vg.font, cairo_font) Hashtbl.t; (* cached fonts. *) prims : (* cached primitives. *) (Vgr.Private.Data.primitive, cairo_primitive) Hashtbl.t; mutable gstate : gstate; } (* current graphic state. *) @@ -124,6 +126,20 @@ let get_primitive s p = try Hashtbl.find s.prims p with let prim = create p in Hashtbl.add s.prims p prim; prim +let get_font s font = try Hashtbl.find s.fonts font with +| Not_found -> + let cairo_font = + let slant = match font.Font.slant with + | `Italic -> Cairo.Italic + | `Normal -> Cairo.Upright + | `Oblique -> Cairo.Oblique in + let weight = match font.Font.weight with + | `W600 | `W700 | `W800 | `W900 -> Cairo.Bold + | _ -> Cairo.Normal in + Font (Cairo.Font_face.create ~family:font.Font.name slant weight) + in + Hashtbl.add s.fonts font cairo_font; cairo_font + let set_source s p = let p = get_primitive s p in if s.gstate.g_stroke != p then begin match p with @@ -135,6 +151,12 @@ let set_stroke s p = s.gstate.g_stroke <- set_source s p let set_fill s p = s.gstate.g_fill <- set_source s p +let set_font s (font, size) = + let Font f = get_font s font in + Cairo.Font_face.set s.ctx f; + Cairo.set_font_size s.ctx size + (*Cairo.set_font_size s.ctx 25.0*) + let set_path s p = let rec loop last = function @@ -191,6 +213,40 @@ let rec r_cut s a = function Cairo.clip s.ctx; s.todo <- (Draw i) :: (save_gstate s) :: s.todo +let rec r_cut_glyphs s a run i = match run.text with +| None -> warn s (`Textless_glyph_cut (image (Cut_glyphs (a, run, i)))) +| Some text -> + Cairo.save s.ctx; + s.todo <- (save_gstate s) :: s.todo; + let m = M3.mul s.view_tr s.gstate.g_tr in + let o = P2.tr m run.o in + let font_size = run.font.Font.size in + set_font s (run.font, font_size); + Cairo.Path.clear s.ctx; + M3.(Cairo.transform s.ctx (cairo_matrix 1.0 0.0 + 0.0 (-1.0) + 0.0 0.0)); + Cairo.move_to s.ctx 0. 0.; + Cairo.Path.text s.ctx text; + begin match a with + | `O o -> + set_outline s o; + begin match i with + | Primitive p -> + set_stroke s p; + Cairo.stroke s.ctx + | _ -> + warn s (`Unsupported_glyph_cut (a, image i)) + end + | `Aeo | `Anz -> + Cairo.clip s.ctx; + M3.(Cairo.transform s.ctx (cairo_matrix 1.0 0.0 + 0.0 (-1.0) + 0.0 0.0)); + s.todo <- Draw i :: s.todo + end + + let rec r_image s k r = if s.cost > limit s then (s.cost <- 0; partial (r_image s k) r) else match s.todo with @@ -214,8 +270,7 @@ let rec r_image s k r = r_image s k r | Cut_glyphs (a, run, i) -> s.todo <- todo; - failwith "todo" - (*r_cut_glyphs s a run i;*) + r_cut_glyphs s a run i; r_image s k r | Blend (_, _, i, i') -> s.todo <- (Draw i') :: (Draw i) :: todo; @@ -256,6 +311,7 @@ let target surface = view = Box2.empty; view_tr = M3.id; todo = []; + fonts = Hashtbl.create 20; prims = Hashtbl.create 231; gstate = init_gstate; } in From 2dcc1e2dd34b4a1698342a8f04fb49b710e60a3f Mon Sep 17 00:00:00 2001 From: Arthur Wendling Date: Wed, 10 Dec 2014 18:05:41 +0100 Subject: [PATCH 08/31] Add Vgr_cairo2 to the doc build --- doc/api.odocl | 1 + doc/dev-api.odocl | 3 ++- pkg/build.ml | 1 + 3 files changed, 4 insertions(+), 1 deletion(-) diff --git a/doc/api.odocl b/doc/api.odocl index 2e908f5..6c71446 100644 --- a/doc/api.odocl +++ b/doc/api.odocl @@ -2,3 +2,4 @@ Vg Vgr_htmlc Vgr_pdf Vgr_svg +Vgr_cairo2 diff --git a/doc/dev-api.odocl b/doc/dev-api.odocl index eb3c4aa..0bcfd00 100644 --- a/doc/dev-api.odocl +++ b/doc/dev-api.odocl @@ -2,5 +2,6 @@ Vg Vgr_htmlc Vgr_pdf Vgr_svg +Vgr_cairo2 Mui -Db \ No newline at end of file +Db diff --git a/pkg/build.ml b/pkg/build.ml index 435c398..ed7cf68 100755 --- a/pkg/build.ml +++ b/pkg/build.ml @@ -22,5 +22,6 @@ let () = Pkg.describe "vg" ~builder:`OCamlbuild [ Pkg.doc "test/min_htmlc.ml"; Pkg.doc "test/min_pdf.ml"; Pkg.doc "test/min_svg.ml"; + Pkg.doc "test/min_cairo2.ml"; Pkg.doc "test/fglyphs.ml"; ] From d1fb37ce2a50df0cbb4fc2140b050768d1748039 Mon Sep 17 00:00:00 2001 From: Arthur Wendling Date: Wed, 10 Dec 2014 18:33:08 +0100 Subject: [PATCH 09/31] Vgr_cairo2: multiple images --- src/vgr_cairo2.ml | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/src/vgr_cairo2.ml b/src/vgr_cairo2.ml index a73a1f7..ceb4e22 100644 --- a/src/vgr_cairo2.ml +++ b/src/vgr_cairo2.ml @@ -78,12 +78,21 @@ let set_dashes s = function let init_ctx s = let o = s.gstate.g_outline in let m = s.view_tr in + Cairo.restore s.ctx; + Cairo.save s.ctx; Cairo.transform s.ctx (cairo_matrix_of_m3 m); Cairo.set_line_width s.ctx o.P.width; Cairo.set_line_cap s.ctx (cairo_cap o.P.cap); Cairo.set_line_join s.ctx (cairo_join o.P.join); Cairo.set_miter_limit s.ctx (Vgr.Private.P.miter_limit o); - set_dashes s o.P.dashes + set_dashes s o.P.dashes; + Cairo.set_operator s.ctx Cairo.CLEAR; + let w = float (Cairo.Image.get_width s.surface) in + let h = float (Cairo.Image.get_height s.surface) in + Cairo.rectangle s.ctx 0. 0. w h; + Cairo.fill s.ctx; + Cairo.set_operator s.ctx Cairo.OVER + let push_transform s tr = let m = match tr with @@ -306,6 +315,7 @@ let render s v k r = match v with let target surface = let target r _ = let ctx = Cairo.create surface in + Cairo.save ctx; true, render { r; surface; ctx; cost = 0; view = Box2.empty; From 3a7212c28616ec396e0f804d2a78ff1f51e8afef Mon Sep 17 00:00:00 2001 From: Arthur Wendling Date: Wed, 10 Dec 2014 18:38:45 +0100 Subject: [PATCH 10/31] Vgr_cairo2: document the API --- src/vgr_cairo2.mli | 74 +++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 73 insertions(+), 1 deletion(-) diff --git a/src/vgr_cairo2.mli b/src/vgr_cairo2.mli index 3a0f1c2..14189ea 100644 --- a/src/vgr_cairo2.mli +++ b/src/vgr_cairo2.mli @@ -1,14 +1,86 @@ (*--------------------------------------------------------------------------- + Copyright 2013 Daniel C. Bünzli. All rights reserved. Distributed under the BSD3 license, see license at the end of the file. %%NAME%% release %%VERSION%% ---------------------------------------------------------------------------*) (** Vg Cairo2 renderer. - {b References.} + {b Dependency:} {ul {- {e {{:http://forge.ocamlcore.org/projects/cairo/}Cairo2 library for OCaml}}}} {e Release %%VERSION%% — %%MAINTAINER%% } *) +(** {1:target Cairo2 render targets} *) + val target : Cairo.Surface.t -> [`Other] Vg.Vgr.target +(** [target s] is a render target for rendering to the Cairo2 surface [s]. + + {b Multiple images.} Multiple images render on the target is supported. + Each new render clears the surface. *) + +(** {1:text Text rendering} + + {b Warning.} The following is subject to change in the future. + + Currently text rendering uses Cairo2's font selection mechanism + and doesn't support the glyph API. + + Given a glyph cut: + +{!Vg.I.cut_glyphs}[ ~text ~blocks ~advances font glyphs] + + The [blocks], [advances] and [glyphs] parameters are ignored. + [text] must be provided and is used to define the text to render. + [font] is used to select the font family. + + The weight is limited to Normal ([< `W600]) and Bold ([>= `W600]). *) + +(** {1:limits Render warnings and limitations} + + The following render warnings are reported. + {ul + {- [`Unsupported_cut (`O o, i)], outline area cuts can be performed + only on (possibly transformed) {!Vg.I.const}, {!Vg.I.axial} and + {!Vg.I.radial} images.} + {- [`Unsupported_glyph_cut (`O o, i)], outline glyph cuts can be + performed only on (untransformed) {!Vg.I.const}, {!Vg.I.axial} + and {!Vg.I.radial} images.} + {- [`Textless_glyph_cut i] if no [text] argument is specified in a + glyph cut.}} + + *) + +(*--------------------------------------------------------------------------- + Copyright 2013 Daniel C. Bünzli. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions + are met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + 3. Neither the name of Daniel C. Bünzli nor the names of + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS + "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT + LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR + A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT + OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, + SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT + LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, + DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY + THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT + (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE + OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + ---------------------------------------------------------------------------*) From 98d1d60eddd71da9e35dba3fc426f5f0535a6fdb Mon Sep 17 00:00:00 2001 From: Arthur Wendling Date: Wed, 10 Dec 2014 18:48:05 +0100 Subject: [PATCH 11/31] Vgr_cairo2: coding convention --- src/vgr_cairo2.ml | 24 ++++++++++++++---------- 1 file changed, 14 insertions(+), 10 deletions(-) diff --git a/src/vgr_cairo2.ml b/src/vgr_cairo2.ml index ceb4e22..a1dfbde 100644 --- a/src/vgr_cairo2.ml +++ b/src/vgr_cairo2.ml @@ -44,7 +44,7 @@ let limit s = Vgr.Private.limit s.r let warn s w = Vgr.Private.warn s.r w let image i = Vgr.Private.I.of_data i -let view_rect s = (* image view rect in current coordinate system. *) +let view_rect s = (* image view rect in current coordinate system. *) let tr = M3.inv s.gstate.g_tr in Vgr.Private.Data.of_path (P.empty >> P.rect (Box2.tr tr s.view)) @@ -107,9 +107,12 @@ let set_outline s o = if s.gstate.g_outline == o then () else let old = s.gstate.g_outline in s.gstate.g_outline <- o; - if old.P.width <> o.P.width then (Cairo.set_line_width s.ctx o.P.width); - if old.P.cap <> o.P.cap then (Cairo.set_line_cap s.ctx (cairo_cap o.P.cap)); - if old.P.join <> o.P.join then (Cairo.set_line_join s.ctx (cairo_join o.P.join)); + if old.P.width <> o.P.width then + (Cairo.set_line_width s.ctx o.P.width); + if old.P.cap <> o.P.cap then + (Cairo.set_line_cap s.ctx (cairo_cap o.P.cap)); + if old.P.join <> o.P.join then + (Cairo.set_line_join s.ctx (cairo_join o.P.join)); if old.P.miter_angle <> o.P.miter_angle then (Cairo.set_miter_limit s.ctx (Vgr.Private.P.miter_limit o)); if old.P.dashes <> o.P.dashes then set_dashes s o.P.dashes; @@ -124,11 +127,12 @@ let get_primitive s p = try Hashtbl.find s.prims p with | Const c -> Pattern Color.(Cairo.Pattern.create_rgba (r c) (g c) (b c) (a c)) | Axial (stops, pt, pt') -> - let g = V2.(Cairo.Pattern.create_linear (x pt) (y pt) (x pt') (y pt')) in + let g = V2.(Cairo.Pattern.create_linear (x pt) (y pt) + (x pt') (y pt')) in List.iter (add_stop g) stops; Pattern g | Radial (stops, f, c, r) -> let g = V2.(Cairo.Pattern.create_radial - ~x0:(x f) ~y0:(y f) ~x1:(x c) ~y1:(y c) ~r0:0.0 ~r1:r) in + (x f) (y f) (x c) (y c) 0.0 r) in List.iter (add_stop g) stops; Pattern g | Raster _ -> assert false in @@ -186,7 +190,9 @@ let set_path s p = | Some (c, m, a, a') -> Cairo.save s.ctx; let c = V2.ltr (M2.inv m) c in - M2.(Cairo.transform s.ctx (cairo_matrix (e00 m) (e10 m) (e01 m) (e11 m) 0. 0.)); + M2.(Cairo.transform s.ctx (cairo_matrix (e00 m) (e10 m) + (e01 m) (e11 m) + 0. 0.)); let arc = if cw then Cairo.arc else Cairo.arc_negative in P2.(arc s.ctx ~x:(x c) ~y:(y c) ~r:1.0 ~a1:a ~a2:a'); Cairo.restore s.ctx; @@ -227,8 +233,6 @@ let rec r_cut_glyphs s a run i = match run.text with | Some text -> Cairo.save s.ctx; s.todo <- (save_gstate s) :: s.todo; - let m = M3.mul s.view_tr s.gstate.g_tr in - let o = P2.tr m run.o in let font_size = run.font.Font.size in set_font s (run.font, font_size); Cairo.Path.clear s.ctx; @@ -268,7 +272,7 @@ let rec r_image s k r = | Draw i :: todo -> s.cost <- s.cost + 1; match i with - | Primitive _ as i -> (* Uncut primitive, just cut to view. *) + | Primitive _ as i -> (* Uncut primitive, just cut to view. *) let p = view_rect s in s.todo <- (Draw (Cut (`Anz, p, i))) :: todo; r_image s k r From 10c33be77d0f5450798d5669a56e7ad7d33e6ee0 Mon Sep 17 00:00:00 2001 From: Arthur Wendling Date: Wed, 10 Dec 2014 19:02:11 +0100 Subject: [PATCH 12/31] Vgr_cairo2: quadratic curves --- src/vgr_cairo2.ml | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/vgr_cairo2.ml b/src/vgr_cairo2.ml index a1dfbde..dcca9a8 100644 --- a/src/vgr_cairo2.ml +++ b/src/vgr_cairo2.ml @@ -178,8 +178,12 @@ let set_path s p = match seg with | `Sub pt -> P2.(Cairo.move_to s.ctx (x pt) (y pt)); loop pt segs | `Line pt -> P2.(Cairo.line_to s.ctx (x pt) (y pt)); loop pt segs - | `Qcurve (c, pt) -> - failwith "todo"; + | `Qcurve (q, pt) -> + let x,y = Cairo.Path.get_current_point s.ctx in + let p0 = V2.v x y in + let c = V2.((q + 2. * p0) / 3.) in + let c' = V2.((pt + 2. * q) / 3.) in + P2.(Cairo.curve_to s.ctx (x c) (y c) (x c') (y c') (x pt) (y pt)); loop pt segs | `Ccurve (c, c', pt) -> P2.(Cairo.curve_to s.ctx (x c) (y c) (x c') (y c') (x pt) (y pt)); From 6655a88980cf0b6d2dcfa92bf43f57cc25e499e2 Mon Sep 17 00:00:00 2001 From: Arthur Wendling Date: Wed, 10 Dec 2014 19:05:07 +0100 Subject: [PATCH 13/31] Vgr_cairo2: correct sizing of minimal example --- test/min_cairo2.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/test/min_cairo2.ml b/test/min_cairo2.ml index 02bc00b..cb6923d 100644 --- a/test/min_cairo2.ml +++ b/test/min_cairo2.ml @@ -21,7 +21,9 @@ let image = I.const (Color.v_srgb 0.314 0.784 0.471) (* 2. Render *) let () = - let surface = Cairo.Image.create Cairo.Image.ARGB32 100 100 in + let w = int_of_float (V2.x size) in + let h = int_of_float (V2.y size) in + let surface = Cairo.Image.create Cairo.Image.ARGB32 w h in let warn w = Vgr.pp_warning Format.err_formatter w in let r = Vgr.create ~warn (Vgr_cairo2.target surface) `Other in ignore (Vgr.render r (`Image (size, view, image))); From d139b7d9dabfb5aef6da416eaa22fcbb610d7b05 Mon Sep 17 00:00:00 2001 From: Arthur Wendling Date: Wed, 10 Dec 2014 22:57:49 +0100 Subject: [PATCH 14/31] Vgr_cairo2: add PNG and PSD targets --- src/vgr_cairo2.ml | 59 ++++++++++++++++++++++++++++++++++++++++++---- src/vgr_cairo2.mli | 6 ++++- 2 files changed, 59 insertions(+), 6 deletions(-) diff --git a/src/vgr_cairo2.ml b/src/vgr_cairo2.ml index dcca9a8..2cbf77b 100644 --- a/src/vgr_cairo2.ml +++ b/src/vgr_cairo2.ml @@ -22,9 +22,13 @@ type gstate = (* subset of the graphics state saved by a Cairo.save ctx *) let init_gstate = { g_tr = M3.id; g_outline = P.o; g_stroke = dumb_prim; g_fill = dumb_prim } +type cairo_backend = [ `Surface | `PNG | `PDF ] + type cmd = Set of gstate | Draw of Vgr.Private.Data.image type state = { r : Vgr.Private.renderer; (* corresponding renderer. *) + backend : cairo_backend; (* final format target. *) + mutable size : Size2.t; (* surface dimensions. *) surface : Cairo.Surface.t; (* surface rendered to. *) ctx : Cairo.context; (* context of [surface]. *) mutable cost : int; (* cost counter for limit. *) @@ -298,11 +302,20 @@ let rec r_image s k r = push_transform s tr; r_image s k r +let vgr_output r str = + let k' _ = `Ok in + ignore (Vgr.Private.writes str 0 (String.length str) k' r) + let render s v k r = match v with -| `End -> k r +| `End -> + begin match s.backend with + | `Surface | `PDF -> () + | `PNG -> Cairo.PNG.write_to_stream s.surface (vgr_output r) + end; + Cairo.Surface.finish s.surface; + Vgr.Private.flush k r | `Image (size, view, i) -> - let cw = float (Cairo.Image.get_width s.surface) in - let ch = float (Cairo.Image.get_height s.surface) in + let cw, ch = Size2.w s.size, Size2.h s.size in (* Map view rect (bot-left coords) to surface (top-left coords) *) let sx = cw /. Box2.w view in let sy = ch /. Box2.h view in @@ -320,11 +333,46 @@ let render s v k r = match v with init_ctx s; r_image s k r -let target surface = +let pre_render resolution backend = + let s = ref None in + fun v k r -> + match !s, v with + | Some s, _ -> render s v k r + | None, `End -> assert false + | None, `Image (size, view, i) -> + let size = V2.(resolution * size) in + let w, h = Size2.w size, Size2.h size in + let surface = match backend with + | `Surface | `PNG -> + Cairo.Image.(create ARGB32 (int_of_float w) (int_of_float h)) + | `PDF -> + Cairo.PDF.create_for_stream (vgr_output r) w h + in + let ctx = Cairo.create surface in + Cairo.save ctx; + let state = + { r; surface; ctx; backend; size; + cost = 0; + view = Box2.empty; + view_tr = M3.id; + todo = []; + fonts = Hashtbl.create 20; + prims = Hashtbl.create 231; + gstate = init_gstate; } in + s := Some state; + render state v k r + +let target ?(resolution = 1.0) backend = + let target _ _ = false, pre_render resolution backend in + Vgr.Private.create_target target + +let target_surface surface = let target r _ = + let size = Size2.v (float (Cairo.Image.get_width surface)) + (float (Cairo.Image.get_width surface)) in let ctx = Cairo.create surface in Cairo.save ctx; - true, render { r; surface; ctx; + true, render { r; surface; ctx; backend = `Surface; size; cost = 0; view = Box2.empty; view_tr = M3.id; @@ -334,3 +382,4 @@ let target surface = gstate = init_gstate; } in Vgr.Private.create_target target + diff --git a/src/vgr_cairo2.mli b/src/vgr_cairo2.mli index 14189ea..78371ae 100644 --- a/src/vgr_cairo2.mli +++ b/src/vgr_cairo2.mli @@ -14,7 +14,11 @@ (** {1:target Cairo2 render targets} *) -val target : Cairo.Surface.t -> [`Other] Vg.Vgr.target +type cairo_backend = [ `Surface | `PNG | `PDF ] + +val target : ?resolution:float -> cairo_backend -> Vg.Vgr.dst_stored Vg.Vgr.target + +val target_surface : Cairo.Surface.t -> [`Other] Vg.Vgr.target (** [target s] is a render target for rendering to the Cairo2 surface [s]. {b Multiple images.} Multiple images render on the target is supported. From cd7ab90afc55bbdc06b54dfad946d2cc763ca93f Mon Sep 17 00:00:00 2001 From: Arthur Wendling Date: Wed, 10 Dec 2014 22:59:22 +0100 Subject: [PATCH 15/31] Vgr_cairo2: bugfix, gradients and arcs --- src/vgr_cairo2.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/vgr_cairo2.ml b/src/vgr_cairo2.ml index 2cbf77b..290addf 100644 --- a/src/vgr_cairo2.ml +++ b/src/vgr_cairo2.ml @@ -136,7 +136,7 @@ let get_primitive s p = try Hashtbl.find s.prims p with List.iter (add_stop g) stops; Pattern g | Radial (stops, f, c, r) -> let g = V2.(Cairo.Pattern.create_radial - (x f) (y f) (x c) (y c) 0.0 r) in + (x f) (y f) 0.0 (x c) (y c) r) in List.iter (add_stop g) stops; Pattern g | Raster _ -> assert false in @@ -201,7 +201,7 @@ let set_path s p = M2.(Cairo.transform s.ctx (cairo_matrix (e00 m) (e10 m) (e01 m) (e11 m) 0. 0.)); - let arc = if cw then Cairo.arc else Cairo.arc_negative in + let arc = if cw then Cairo.arc_negative else Cairo.arc in P2.(arc s.ctx ~x:(x c) ~y:(y c) ~r:1.0 ~a1:a ~a2:a'); Cairo.restore s.ctx; loop pt segs From 28e7923e625b442d548c6a56caf4ff069eb6eb50 Mon Sep 17 00:00:00 2001 From: Arthur Wendling Date: Wed, 10 Dec 2014 23:06:07 +0100 Subject: [PATCH 16/31] Vgr_cairo2: bugfix, sRGB --- src/vgr_cairo2.ml | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/vgr_cairo2.ml b/src/vgr_cairo2.ml index 290addf..7881d14 100644 --- a/src/vgr_cairo2.ml +++ b/src/vgr_cairo2.ml @@ -125,11 +125,13 @@ let set_outline s o = let get_primitive s p = try Hashtbl.find s.prims p with | Not_found -> let add_stop g (t, c) = + let c = Color.to_srgb c in Cairo.Pattern.add_color_stop_rgba g ~ofs:t - (Color.r c) (Color.g c) (Color.b c) (Color.a c) in + (V4.x c) (V4.y c) (V4.z c) (V4.w c) in let create = function | Const c -> - Pattern Color.(Cairo.Pattern.create_rgba (r c) (g c) (b c) (a c)) + let c = Color.to_srgb c in + Pattern V4.(Cairo.Pattern.create_rgba (x c) (y c) (z c) (w c)) | Axial (stops, pt, pt') -> let g = V2.(Cairo.Pattern.create_linear (x pt) (y pt) (x pt') (y pt')) in From 67be04560eb43b67291c683883e3875a7c3cb514 Mon Sep 17 00:00:00 2001 From: Arthur Wendling Date: Wed, 10 Dec 2014 23:37:52 +0100 Subject: [PATCH 17/31] Vgr_cairo2: update minimal example to output PNG --- test/min_cairo2.ml | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/test/min_cairo2.ml b/test/min_cairo2.ml index cb6923d..b1bc5ea 100644 --- a/test/min_cairo2.ml +++ b/test/min_cairo2.ml @@ -21,11 +21,7 @@ let image = I.const (Color.v_srgb 0.314 0.784 0.471) (* 2. Render *) let () = - let w = int_of_float (V2.x size) in - let h = int_of_float (V2.y size) in - let surface = Cairo.Image.create Cairo.Image.ARGB32 w h in let warn w = Vgr.pp_warning Format.err_formatter w in - let r = Vgr.create ~warn (Vgr_cairo2.target surface) `Other in + let r = Vgr.create ~warn (Vgr_cairo2.target `PNG) (`Channel stdout) in ignore (Vgr.render r (`Image (size, view, image))); - ignore (Vgr.render r `End); - Cairo.PNG.write surface "min_cairo2.png" + ignore (Vgr.render r `End) From ed666269ecfc64bf16d57b4d03bc5c4b5d152887 Mon Sep 17 00:00:00 2001 From: Arthur Wendling Date: Wed, 10 Dec 2014 23:45:17 +0100 Subject: [PATCH 18/31] Vgr_cairo2: output db examples to PDF --- _tags | 3 +++ test/rcairo2_pdf.ml | 47 +++++++++++++++++++++++++++++++++++++++++++++ test/tests.itarget | 3 ++- 3 files changed, 52 insertions(+), 1 deletion(-) create mode 100644 test/rcairo2_pdf.ml diff --git a/_tags b/_tags index 1af964a..ce4bf12 100644 --- a/_tags +++ b/_tags @@ -27,6 +27,9 @@ : package(gg), package(uutf), package(unix) + : package(gg), package(uutf), \ + package(unix), package(cairo2) + : package(gg), package(otfm), package(uutf), \ package(js_of_ocaml), \ package(js_of_ocaml.syntax), syntax(camlp4o) diff --git a/test/rcairo2_pdf.ml b/test/rcairo2_pdf.ml new file mode 100644 index 0000000..d4aed54 --- /dev/null +++ b/test/rcairo2_pdf.ml @@ -0,0 +1,47 @@ +(*--------------------------------------------------------------------------- + Copyright 2013 Daniel C. Bünzli. All rights reserved. + Distributed under the BSD3 license, see license at the end of the file. + %%NAME%% release %%VERSION%% + ---------------------------------------------------------------------------*) + +open Gg +open Vg + +include Db_contents + +let renderer dst _ = Vgr.create (Vgr_cairo2.target `PDF) dst + +let () = Rstored.main ~no_pack:true "Cairo2-PDF" "pdf" renderer + +(*--------------------------------------------------------------------------- + Copyright 2013 Daniel C. Bünzli. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions + are met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + 3. Neither the name of Daniel C. Bünzli nor the names of + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS + "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT + LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR + A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT + OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, + SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT + LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, + DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY + THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT + (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE + OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + ---------------------------------------------------------------------------*) diff --git a/test/tests.itarget b/test/tests.itarget index ed9c47a..f359b83 100644 --- a/test/tests.itarget +++ b/test/tests.itarget @@ -3,8 +3,9 @@ min_pdf.native min_htmlc.byte rsvg.native rpdf.native +rcairo2_pdf.native rhtmlc.byte examples.native sqc.byte vecho.native -fglyphs.native \ No newline at end of file +fglyphs.native From e4c5affa50dafbeec907ace5830aa29e7811957f Mon Sep 17 00:00:00 2001 From: Arthur Wendling Date: Thu, 11 Dec 2014 11:51:56 +0100 Subject: [PATCH 19/31] Rstored: allow renderers to have multiple file formats --- test/rstored.ml | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/test/rstored.ml b/test/rstored.ml index df467fd..d351b5d 100644 --- a/test/rstored.ml +++ b/test/rstored.ml @@ -157,13 +157,14 @@ let pp_image_info ppf i = (* Command line *) -let main ?(no_pack = false) rname ftype renderer = +let main_formats ?(no_pack = false) rname ftypes renderer = let usage = Printf.sprintf "Usage: %s [OPTION]... [ID1] [ID2]...\n\ \ Renders images of the Vg image database to %s files.\n\ \ Without any selector and ID specified renders all images.\n\ Options:" exec rname in + let ftype = ref (List.hd ftypes) in let cmd = ref `Image_render in let set_cmd v () = cmd := v in let list () = let l = ref [] in (l, fun v -> l := v :: !l) in @@ -176,7 +177,11 @@ let main ?(no_pack = false) rname ftype renderer = let use_unix = ref false in let usize = ref unix_buffer_size in let nat s r v = if v > 0 then r := v else log "%s must be > 0, ignored\n" s in - let options = [ + let options = + (if ftypes = [] then [] else [ + "-format", Arg.Symbol (ftypes, ( := ) ftype), + Printf.sprintf "Selects the image format (default: %s)" !ftype + ]) @ [ "-dump", Arg.Unit (set_cmd `Image_dump), (str " Output a textual internal representation"); "-p", Arg.String add_prefix, @@ -209,11 +214,12 @@ let main ?(no_pack = false) rname ftype renderer = in match !cmd with | `Image_render -> - let render = render !sout !use_unix !usize !dir ftype !pack renderer in + let renderer = renderer !ftype in + let render = render !sout !use_unix !usize !dir !ftype !pack renderer in let dur = duration render imgs in log "Wrote %d images in %a.@." (List.length imgs) pp_dur dur | `Image_dump -> - let dur = duration (List.iter (dump !dir ftype)) imgs in + let dur = duration (List.iter (dump !dir !ftype)) imgs in log "Wrote %d images in %a.@." (List.length imgs) pp_dur dur | `Image_info -> pp Format.std_formatter "@[%a@]@." (pp_list pp_image_info) imgs @@ -225,6 +231,9 @@ let main ?(no_pack = false) rname ftype renderer = let tags = List.fold_left add_tags [] imgs in List.iter print_endline (List.sort compare tags) +let main ?no_pack rname ftype renderer = + main_formats ?no_pack rname [ftype] (fun _ -> renderer) + (*--------------------------------------------------------------------------- Copyright 2013 Daniel C. Bünzli. All rights reserved. From 2efa3cb0b194220594d4c89a30e8181e52859050 Mon Sep 17 00:00:00 2001 From: Arthur Wendling Date: Thu, 11 Dec 2014 12:00:04 +0100 Subject: [PATCH 20/31] Vgr_cairo2: rcairo2 has multiple formats --- _tags | 4 ++-- test/{rcairo2_pdf.ml => rcairo2.ml} | 15 ++++++++++++--- test/tests.itarget | 2 +- 3 files changed, 15 insertions(+), 6 deletions(-) rename test/{rcairo2_pdf.ml => rcairo2.ml} (88%) diff --git a/_tags b/_tags index ce4bf12..f959fb1 100644 --- a/_tags +++ b/_tags @@ -27,8 +27,8 @@ : package(gg), package(uutf), package(unix) - : package(gg), package(uutf), \ - package(unix), package(cairo2) + : package(gg), package(uutf), \ + package(unix), package(cairo2) : package(gg), package(otfm), package(uutf), \ package(js_of_ocaml), \ diff --git a/test/rcairo2_pdf.ml b/test/rcairo2.ml similarity index 88% rename from test/rcairo2_pdf.ml rename to test/rcairo2.ml index d4aed54..502730a 100644 --- a/test/rcairo2_pdf.ml +++ b/test/rcairo2.ml @@ -9,9 +9,18 @@ open Vg include Db_contents -let renderer dst _ = Vgr.create (Vgr_cairo2.target `PDF) dst - -let () = Rstored.main ~no_pack:true "Cairo2-PDF" "pdf" renderer +let formats = [ + "png", `PNG; + "pdf", `PDF; + ] + +let renderer fmt dst _ = + let cairo_fmt = List.assoc fmt formats in + Vgr.create (Vgr_cairo2.target cairo_fmt) dst + +let ftypes = List.map fst formats +let () = + Rstored.main_formats ~no_pack:true "a selected format" ftypes renderer (*--------------------------------------------------------------------------- Copyright 2013 Daniel C. Bünzli. diff --git a/test/tests.itarget b/test/tests.itarget index f359b83..ada1e20 100644 --- a/test/tests.itarget +++ b/test/tests.itarget @@ -3,7 +3,7 @@ min_pdf.native min_htmlc.byte rsvg.native rpdf.native -rcairo2_pdf.native +rcairo2.native rhtmlc.byte examples.native sqc.byte From 407ed906fe64f74e69537d7ac553f6f975f6c7d9 Mon Sep 17 00:00:00 2001 From: Arthur Wendling Date: Thu, 11 Dec 2014 12:47:50 +0100 Subject: [PATCH 21/31] Add cairo2 to .merlin --- .merlin | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.merlin b/.merlin index 89ea845..ebd3dcd 100644 --- a/.merlin +++ b/.merlin @@ -1,3 +1,3 @@ EXT js -PKG gg js_of_ocaml +PKG gg js_of_ocaml cairo2 B _build/** From 733bf8db0d83af51663c2e656c5f4207ead88f2c Mon Sep 17 00:00:00 2001 From: Arthur Wendling Date: Thu, 11 Dec 2014 13:06:11 +0100 Subject: [PATCH 22/31] Vgr_cairo2: add PS and SVG formats --- src/vgr_cairo2.ml | 18 +++++++++--------- src/vgr_cairo2.mli | 5 ++--- test/rcairo2.ml | 2 ++ 3 files changed, 13 insertions(+), 12 deletions(-) diff --git a/src/vgr_cairo2.ml b/src/vgr_cairo2.ml index 7881d14..9d90317 100644 --- a/src/vgr_cairo2.ml +++ b/src/vgr_cairo2.ml @@ -22,7 +22,7 @@ type gstate = (* subset of the graphics state saved by a Cairo.save ctx *) let init_gstate = { g_tr = M3.id; g_outline = P.o; g_stroke = dumb_prim; g_fill = dumb_prim } -type cairo_backend = [ `Surface | `PNG | `PDF ] +type cairo_backend = [ `Surface | `PDF | `PNG | `PS | `SVG ] type cmd = Set of gstate | Draw of Vgr.Private.Data.image type state = @@ -310,10 +310,8 @@ let vgr_output r str = let render s v k r = match v with | `End -> - begin match s.backend with - | `Surface | `PDF -> () - | `PNG -> Cairo.PNG.write_to_stream s.surface (vgr_output r) - end; + if s.backend = `PNG then + Cairo.PNG.write_to_stream s.surface (vgr_output r); Cairo.Surface.finish s.surface; Vgr.Private.flush k r | `Image (size, view, i) -> @@ -345,15 +343,17 @@ let pre_render resolution backend = let size = V2.(resolution * size) in let w, h = Size2.w size, Size2.h size in let surface = match backend with - | `Surface | `PNG -> + | `PNG -> Cairo.Image.(create ARGB32 (int_of_float w) (int_of_float h)) - | `PDF -> - Cairo.PDF.create_for_stream (vgr_output r) w h + | `PDF -> Cairo.PDF.create_for_stream (vgr_output r) w h + | `PS -> Cairo.PS.create_for_stream (vgr_output r) w h + | `SVG -> Cairo.SVG.create_for_stream (vgr_output r) w h in let ctx = Cairo.create surface in Cairo.save ctx; let state = - { r; surface; ctx; backend; size; + { r; surface; ctx; size; + backend = (backend :> cairo_backend); cost = 0; view = Box2.empty; view_tr = M3.id; diff --git a/src/vgr_cairo2.mli b/src/vgr_cairo2.mli index 78371ae..3dfdc01 100644 --- a/src/vgr_cairo2.mli +++ b/src/vgr_cairo2.mli @@ -14,9 +14,8 @@ (** {1:target Cairo2 render targets} *) -type cairo_backend = [ `Surface | `PNG | `PDF ] - -val target : ?resolution:float -> cairo_backend -> Vg.Vgr.dst_stored Vg.Vgr.target +val target : ?resolution:float -> [< `PDF | `PNG | `PS | `SVG ] -> + Vg.Vgr.dst_stored Vg.Vgr.target val target_surface : Cairo.Surface.t -> [`Other] Vg.Vgr.target (** [target s] is a render target for rendering to the Cairo2 surface [s]. diff --git a/test/rcairo2.ml b/test/rcairo2.ml index 502730a..db1724e 100644 --- a/test/rcairo2.ml +++ b/test/rcairo2.ml @@ -12,6 +12,8 @@ include Db_contents let formats = [ "png", `PNG; "pdf", `PDF; + "ps", `PS; + "svg", `SVG; ] let renderer fmt dst _ = From ed63b2448b24ae630cc8ac8ac696f335c19e7b2f Mon Sep 17 00:00:00 2001 From: Arthur Wendling Date: Thu, 11 Dec 2014 17:28:46 +0100 Subject: [PATCH 23/31] Vgr_cairo2: update copyright --- src/vgr_cairo2.ml | 4 +++- src/vgr_cairo2.mli | 4 +++- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/src/vgr_cairo2.ml b/src/vgr_cairo2.ml index 9d90317..1ebca1b 100644 --- a/src/vgr_cairo2.ml +++ b/src/vgr_cairo2.ml @@ -1,9 +1,11 @@ (*--------------------------------------------------------------------------- - Copyright 2013 Daniel C. Bünzli. All rights reserved. + Copyright 2014 Arthur Wendling, Daniel C. Bünzli. All rights reserved. Distributed under the BSD3 license, see license at the end of the file. %%NAME%% release %%VERSION%% ---------------------------------------------------------------------------*) +(* Based on the Vgr_htmlc implementation by Daniel C. Bünzli. *) + open Gg open Vg open Vgr.Private.Data diff --git a/src/vgr_cairo2.mli b/src/vgr_cairo2.mli index 3dfdc01..bd12042 100644 --- a/src/vgr_cairo2.mli +++ b/src/vgr_cairo2.mli @@ -1,9 +1,11 @@ (*--------------------------------------------------------------------------- - Copyright 2013 Daniel C. Bünzli. All rights reserved. + Copyright 2014 Arthur Wendling, Daniel C. Bünzli. All rights reserved. Distributed under the BSD3 license, see license at the end of the file. %%NAME%% release %%VERSION%% ---------------------------------------------------------------------------*) +(* Based on the Vgr_htmlc documentation by Daniel C. Bünzli. *) + (** Vg Cairo2 renderer. {b Dependency:} From bb03cdf8dce3220b7cb13faacbe83e94b984e743 Mon Sep 17 00:00:00 2001 From: Arthur Wendling Date: Thu, 11 Dec 2014 17:55:44 +0100 Subject: [PATCH 24/31] Rename to Vgr_cairo --- doc/api.odocl | 2 +- doc/dev-api.odocl | 2 +- opam | 2 +- pkg/META | 14 ++++++------ pkg/build.ml | 4 ++-- src/{vgr_cairo2.ml => vgr_cairo.ml} | 32 +++++++++++++++++++++++++++ src/{vgr_cairo2.mli => vgr_cairo.mli} | 2 +- src/vgr_cairo.mllib | 1 + src/vgr_cairo2.mllib | 1 - test/{min_cairo2.ml => min_cairo.ml} | 4 ++-- test/{rcairo2.ml => rcairo.ml} | 6 ++--- 11 files changed, 51 insertions(+), 19 deletions(-) rename src/{vgr_cairo2.ml => vgr_cairo.ml} (88%) rename src/{vgr_cairo2.mli => vgr_cairo.mli} (98%) create mode 100644 src/vgr_cairo.mllib delete mode 100644 src/vgr_cairo2.mllib rename test/{min_cairo2.ml => min_cairo.ml} (82%) rename test/{rcairo2.ml => rcairo.ml} (94%) diff --git a/doc/api.odocl b/doc/api.odocl index 6c71446..47c48f0 100644 --- a/doc/api.odocl +++ b/doc/api.odocl @@ -2,4 +2,4 @@ Vg Vgr_htmlc Vgr_pdf Vgr_svg -Vgr_cairo2 +Vgr_cairo diff --git a/doc/dev-api.odocl b/doc/dev-api.odocl index 0bcfd00..2389c59 100644 --- a/doc/dev-api.odocl +++ b/doc/dev-api.odocl @@ -2,6 +2,6 @@ Vg Vgr_htmlc Vgr_pdf Vgr_svg -Vgr_cairo2 +Vgr_cairo Mui Db diff --git a/opam b/opam index 6e6be18..baecc68 100644 --- a/opam +++ b/opam @@ -9,7 +9,7 @@ tags: [ "pdf" "svg" "html-canvas" "declarative" "graphics" "org:erratique" ] license: "BSD3" ocaml-version: [>= "4.01.0"] depends: [ "ocamlfind" "gg" {>= "0.9.0"} ] -depopts: [ "uutf" "otfm" "js_of_ocaml" ] +depopts: [ "uutf" "otfm" "js_of_ocaml" "cairo2" ] build: [ [ "ocaml" "pkg/git.ml" ] diff --git a/pkg/META b/pkg/META index 9db2140..fff9212 100644 --- a/pkg/META +++ b/pkg/META @@ -40,13 +40,13 @@ package "htmlc" ( exists_if = "vgr_htmlc.cma" ) -package "cairo2" ( +package "cairo" ( version = "%%VERSION%%" - description = "Vg's Cairo2 renderer" + description = "Vg's Cairo renderer" requires = "vg cairo2" - archive(byte) = "vgr_cairo2.cma" - archive(byte, plugin) = "vgr_cairo2.cma" - archive(native) = "vgr_cairo2.cmxa" - archive(native, plugin) = "vgr_cairo2.cmxs" - exists_if = "vgr_cairo2.cma" + archive(byte) = "vgr_cairo.cma" + archive(byte, plugin) = "vgr_cairo.cma" + archive(native) = "vgr_cairo.cmxa" + archive(native, plugin) = "vgr_cairo.cmxs" + exists_if = "vgr_cairo.cma" ) diff --git a/pkg/build.ml b/pkg/build.ml index ed7cf68..d02cd13 100755 --- a/pkg/build.ml +++ b/pkg/build.ml @@ -15,13 +15,13 @@ let () = Pkg.describe "vg" ~builder:`OCamlbuild [ Pkg.lib ~cond:vgr_pdf ~exts:Exts.module_library "src/vgr_pdf"; Pkg.bin ~cond:vgr_pdf ~auto:true "test/vecho"; Pkg.lib ~cond:jsoo ~exts:Exts.module_library "src/vgr_htmlc"; - Pkg.lib ~cond:cairo2 ~exts:Exts.module_library "src/vgr_cairo2"; + Pkg.lib ~cond:cairo2 ~exts:Exts.module_library "src/vgr_cairo"; Pkg.doc "README.md"; Pkg.doc "CHANGES.md"; Pkg.doc "test/min_htmlc.html"; Pkg.doc "test/min_htmlc.ml"; Pkg.doc "test/min_pdf.ml"; Pkg.doc "test/min_svg.ml"; - Pkg.doc "test/min_cairo2.ml"; + Pkg.doc "test/min_cairo.ml"; Pkg.doc "test/fglyphs.ml"; ] diff --git a/src/vgr_cairo2.ml b/src/vgr_cairo.ml similarity index 88% rename from src/vgr_cairo2.ml rename to src/vgr_cairo.ml index 1ebca1b..9485e65 100644 --- a/src/vgr_cairo2.ml +++ b/src/vgr_cairo.ml @@ -387,3 +387,35 @@ let target_surface surface = in Vgr.Private.create_target target +(*--------------------------------------------------------------------------- + Copyright 2014 Arthur Wendling, Daniel C. Bünzli. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions + are met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + 3. Neither the name of Daniel C. Bünzli nor the names of + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS + "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT + LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR + A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT + OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, + SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT + LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, + DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY + THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT + (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE + OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + ---------------------------------------------------------------------------*) diff --git a/src/vgr_cairo2.mli b/src/vgr_cairo.mli similarity index 98% rename from src/vgr_cairo2.mli rename to src/vgr_cairo.mli index bd12042..f21d763 100644 --- a/src/vgr_cairo2.mli +++ b/src/vgr_cairo.mli @@ -58,7 +58,7 @@ val target_surface : Cairo.Surface.t -> [`Other] Vg.Vgr.target *) (*--------------------------------------------------------------------------- - Copyright 2013 Daniel C. Bünzli. + Copyright 2014 Arthur Wendling, Daniel C. Bünzli. All rights reserved. Redistribution and use in source and binary forms, with or without diff --git a/src/vgr_cairo.mllib b/src/vgr_cairo.mllib new file mode 100644 index 0000000..db30c28 --- /dev/null +++ b/src/vgr_cairo.mllib @@ -0,0 +1 @@ +Vgr_cairo diff --git a/src/vgr_cairo2.mllib b/src/vgr_cairo2.mllib deleted file mode 100644 index 9365b41..0000000 --- a/src/vgr_cairo2.mllib +++ /dev/null @@ -1 +0,0 @@ -Vgr_cairo2 diff --git a/test/min_cairo2.ml b/test/min_cairo.ml similarity index 82% rename from test/min_cairo2.ml rename to test/min_cairo.ml index b1bc5ea..804d984 100644 --- a/test/min_cairo2.ml +++ b/test/min_cairo.ml @@ -1,6 +1,6 @@ (* This code is in the public domain. - Minimal Vgr_cairo2 example. Compile with: + Minimal Vgr_cairo example. Compile with: ocamlfind ocamlc \ -package cairo2 \ @@ -22,6 +22,6 @@ let image = I.const (Color.v_srgb 0.314 0.784 0.471) let () = let warn w = Vgr.pp_warning Format.err_formatter w in - let r = Vgr.create ~warn (Vgr_cairo2.target `PNG) (`Channel stdout) in + let r = Vgr.create ~warn (Vgr_cairo.target `PNG) (`Channel stdout) in ignore (Vgr.render r (`Image (size, view, image))); ignore (Vgr.render r `End) diff --git a/test/rcairo2.ml b/test/rcairo.ml similarity index 94% rename from test/rcairo2.ml rename to test/rcairo.ml index db1724e..cec9d5e 100644 --- a/test/rcairo2.ml +++ b/test/rcairo.ml @@ -1,5 +1,5 @@ (*--------------------------------------------------------------------------- - Copyright 2013 Daniel C. Bünzli. All rights reserved. + Copyright 2014 Arthur Wendling. All rights reserved. Distributed under the BSD3 license, see license at the end of the file. %%NAME%% release %%VERSION%% ---------------------------------------------------------------------------*) @@ -18,14 +18,14 @@ let formats = [ let renderer fmt dst _ = let cairo_fmt = List.assoc fmt formats in - Vgr.create (Vgr_cairo2.target cairo_fmt) dst + Vgr.create (Vgr_cairo.target cairo_fmt) dst let ftypes = List.map fst formats let () = Rstored.main_formats ~no_pack:true "a selected format" ftypes renderer (*--------------------------------------------------------------------------- - Copyright 2013 Daniel C. Bünzli. + Copyright 2014 Arthur Wendling. All rights reserved. Redistribution and use in source and binary forms, with or without From 18de4d793a4285869c234752e9ba48e2f7ab2502 Mon Sep 17 00:00:00 2001 From: Arthur Wendling Date: Thu, 11 Dec 2014 18:48:02 +0100 Subject: [PATCH 25/31] Vgr_cairo: update dependencies in README --- README.md | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/README.md b/README.md index 0173fda..4597f61 100644 --- a/README.md +++ b/README.md @@ -12,13 +12,15 @@ module. An API allows to implement new renderers. Vg depends only on [Gg][1]. The SVG renderer has no dependency, the PDF renderer depends on [Uutf][2] and [Otfm][3], the HTML canvas -renderer depends on [js_of_ocaml][4]. Vg and its renderers are -distributed under the BSD3 license. +renderer depends on [js_of_ocaml][4], the Cairo renderer depends on +[cairo2][5]. Vg and its renderers are distributed under the BSD3 +license. [1]: http://erratique.ch/software/gg [2]: http://erratique.ch/software/uutf [3]: http://erratique.ch/software/otfm [4]: http://ocsigen.org/js_of_ocaml/ +[5]: https://forge.ocamlcore.org/projects/cairo/ Home page: http://erratique.ch/software/vg Contact: Daniel Bünzli `` @@ -28,8 +30,8 @@ Contact: Daniel Bünzli `` Vg can be installed with `opam`: - opam install vg # SVG renderer only - opam install uutf otfm js_of_ocaml vg # all renderers + opam install vg # SVG renderer only + opam install uutf otfm js_of_ocaml cairo2 vg # all renderers If you don't use `opam` consult the [`opam`](opam) file for build instructions and a complete specification of the dependencies. @@ -64,6 +66,8 @@ The resulting binaries are in `_build/test` : - `min_htmlc.byte`, minimal example to render with the HTML canvas. - `rsvg.native`, renders images of the Vg image database to SVG files. - `rpdf.native`, renders images of the Vg image database to PDF files. +- `rcairo.native`, renders images of the Vg image database with Cairo + to PDF, PNG, PS or SVG files. - `rhtmlc.html` and `rhtmlc.byte` can be processed with `js_of_ocaml`, the resulting webapp renders images of the Vg image database with the HTML canvas, PDF and SVG renderers. From 22fc3da4f62b3a5ddd0d1c71a8a32a1e13d540d7 Mon Sep 17 00:00:00 2001 From: Arthur Wendling Date: Fri, 12 Dec 2014 21:45:28 +0100 Subject: [PATCH 26/31] Vgr_cairo: documentation --- _tags | 6 +++--- build | 2 +- src/vgr_cairo.ml | 36 +++++++++++++++++++++++++----------- src/vgr_cairo.mli | 37 ++++++++++++++++++++++++++++--------- test/tests.itarget | 2 +- 5 files changed, 58 insertions(+), 25 deletions(-) diff --git a/_tags b/_tags index f959fb1..9cf4932 100644 --- a/_tags +++ b/_tags @@ -12,7 +12,7 @@ : package(gg), package(uutf), package(otfm) -: package(gg), package(cairo2) +: package(gg), package(cairo2) : package(gg) : package(uutf) @@ -27,8 +27,8 @@ : package(gg), package(uutf), package(unix) - : package(gg), package(uutf), \ - package(unix), package(cairo2) + : package(gg), package(uutf), \ + package(unix), package(cairo2) : package(gg), package(otfm), package(uutf), \ package(js_of_ocaml), \ diff --git a/build b/build index 376d4c4..96da7cc 100755 --- a/build +++ b/build @@ -11,7 +11,7 @@ OCAMLBUILD=${OCAMLBUILD:="ocamlbuild -tag debug -classic-display \ action () { case $1 in - default) $OCAMLBUILD vg.cmx vgr_pdf.cmx vgr_svg.cmx vgr_htmlc.cmx vgr_cairo2.cmx ;; + default) $OCAMLBUILD vg.cmx vgr_pdf.cmx vgr_svg.cmx vgr_htmlc.cmx vgr_cairo.cmx ;; tests) $OCAMLBUILD rpdf.native rsvg.native; action rhtmlc ;; rhtmlc) shift; pkg/db-locs diff --git a/src/vgr_cairo.ml b/src/vgr_cairo.ml index 9485e65..4134172 100644 --- a/src/vgr_cairo.ml +++ b/src/vgr_cairo.ml @@ -10,6 +10,8 @@ open Gg open Vg open Vgr.Private.Data +let err_zero_size () = invalid_arg "Cairo surface has a size of zero" + type cairo_font = Font : 'a Cairo.Font_face.t -> cairo_font type cairo_primitive = Pattern : 'a Cairo.Pattern.t -> cairo_primitive @@ -314,10 +316,13 @@ let render s v k r = match v with | `End -> if s.backend = `PNG then Cairo.PNG.write_to_stream s.surface (vgr_output r); - Cairo.Surface.finish s.surface; - Vgr.Private.flush k r + if s.backend = `Surface + then k r + else (Cairo.Surface.finish s.surface; Vgr.Private.flush k r) | `Image (size, view, i) -> let cw, ch = Size2.w s.size, Size2.h s.size in + if cw = 0.0 || ch = 0.0 + then err_zero_size () ; (* Map view rect (bot-left coords) to surface (top-left coords) *) let sx = cw /. Box2.w view in let sy = ch /. Box2.h view in @@ -335,14 +340,13 @@ let render s v k r = match v with init_ctx s; r_image s k r -let pre_render resolution backend = +let format_render ?size backend = let s = ref None in fun v k r -> match !s, v with | Some s, _ -> render s v k r - | None, `End -> assert false + | None, `End -> k r | None, `Image (size, view, i) -> - let size = V2.(resolution * size) in let w, h = Size2.w size, Size2.h size in let surface = match backend with | `PNG -> @@ -366,17 +370,27 @@ let pre_render resolution backend = s := Some state; render state v k r -let target ?(resolution = 1.0) backend = - let target _ _ = false, pre_render resolution backend in +let target backend = + let target _ _ = false, format_render backend in Vgr.Private.create_target target -let target_surface surface = +let target_surface ?size surface = let target r _ = - let size = Size2.v (float (Cairo.Image.get_width surface)) - (float (Cairo.Image.get_width surface)) in + let sw = Cairo.Image.get_width surface in + let sh = Cairo.Image.get_height surface in + let size = + if sw > 0 && sh > 0 + then Size2.v (float sw) (float sh) + else match size with + | None -> err_zero_size () + | Some s -> + if Size2.w s > 0.0 && Size2.h s > 0.0 + then s + else err_zero_size () in let ctx = Cairo.create surface in Cairo.save ctx; - true, render { r; surface; ctx; backend = `Surface; size; + true, render { r; surface; ctx; + backend = `Surface; size; cost = 0; view = Box2.empty; view_tr = M3.id; diff --git a/src/vgr_cairo.mli b/src/vgr_cairo.mli index f21d763..0523f81 100644 --- a/src/vgr_cairo.mli +++ b/src/vgr_cairo.mli @@ -6,7 +6,7 @@ (* Based on the Vgr_htmlc documentation by Daniel C. Bünzli. *) -(** Vg Cairo2 renderer. +(** Vg Cairo renderer. {b Dependency:} {ul {- {e {{:http://forge.ocamlcore.org/projects/cairo/}Cairo2 library @@ -14,22 +14,38 @@ {e Release %%VERSION%% — %%MAINTAINER%% } *) -(** {1:target Cairo2 render targets} *) +(** {1:target Cairo render targets} *) -val target : ?resolution:float -> [< `PDF | `PNG | `PS | `SVG ] -> - Vg.Vgr.dst_stored Vg.Vgr.target +val target : [< `PDF | `PNG | `PS | `SVG ] -> Vg.Vgr.dst_stored Vg.Vgr.target +(** [target fmt] is a render target for rendering to the stored destination + given to {!Vg.Vgr.create} in the chosen format [fmt]. -val target_surface : Cairo.Surface.t -> [`Other] Vg.Vgr.target -(** [target s] is a render target for rendering to the Cairo2 surface [s]. + {b Multiple images.} Multiple images render on the target are not + supported. [Invalid_argument] is raised by {!Vg.Vgr.render} if multiple + images are rendered. *) + +val target_surface : ?size:Gg.size2 -> Cairo.Surface.t -> + [`Other] Vg.Vgr.target +(** [target_surface s] is a render target for rendering to the Cairo + surface [s]. + {ul + {- The physical size of {{!Vg.Vgr.renderable}renderables} is ignored and + the view rectangle is mapped on the surface size.} + {- Surfaces created with [Cairo.Surface] have a valid size, while file + based surfaces have a size of zero by default. If the size of the + surface can not be determined, the optional argument [size] is used + instead. [Invalid_argument] is raised if the size is invalid.}} {b Multiple images.} Multiple images render on the target is supported. - Each new render clears the surface. *) + Each new render clears the surface. However, the results are dependent on + Cairo internals: file based surfaces for PDF, PS and SVG do not clear the + view and blend the different images instead. *) (** {1:text Text rendering} {b Warning.} The following is subject to change in the future. - Currently text rendering uses Cairo2's font selection mechanism + Currently text rendering uses Cairo's font selection mechanism and doesn't support the glyph API. Given a glyph cut: @@ -55,7 +71,10 @@ val target_surface : Cairo.Surface.t -> [`Other] Vg.Vgr.target {- [`Textless_glyph_cut i] if no [text] argument is specified in a glyph cut.}} - *) + The following limitations should be taken into account. + {ul + {- In Cairo, the gradient color interpolation is performed + in (non-linear) sRGB space. This doesn't respect Vg's semantics.}} *) (*--------------------------------------------------------------------------- Copyright 2014 Arthur Wendling, Daniel C. Bünzli. diff --git a/test/tests.itarget b/test/tests.itarget index ada1e20..f6f2b3f 100644 --- a/test/tests.itarget +++ b/test/tests.itarget @@ -3,7 +3,7 @@ min_pdf.native min_htmlc.byte rsvg.native rpdf.native -rcairo2.native +rcairo.native rhtmlc.byte examples.native sqc.byte From 869524bd3f5c462821ffec5ef98ea26fb47e0d58 Mon Sep 17 00:00:00 2001 From: Arthur Wendling Date: Fri, 12 Dec 2014 22:03:59 +0100 Subject: [PATCH 27/31] Vgr_cairo: resolution --- src/vgr_cairo.ml | 25 +++++++++++++++---------- src/vgr_cairo.mli | 14 +++++++++----- test/rcairo.ml | 4 +++- 3 files changed, 27 insertions(+), 16 deletions(-) diff --git a/src/vgr_cairo.ml b/src/vgr_cairo.ml index 4134172..a3ac44b 100644 --- a/src/vgr_cairo.ml +++ b/src/vgr_cairo.ml @@ -12,6 +12,8 @@ open Vgr.Private.Data let err_zero_size () = invalid_arg "Cairo surface has a size of zero" +let default_resolution = Size2.v 1000.0 1000.0 + type cairo_font = Font : 'a Cairo.Font_face.t -> cairo_font type cairo_primitive = Pattern : 'a Cairo.Pattern.t -> cairo_primitive @@ -31,6 +33,7 @@ type cairo_backend = [ `Surface | `PDF | `PNG | `PS | `SVG ] type cmd = Set of gstate | Draw of Vgr.Private.Data.image type state = { r : Vgr.Private.renderer; (* corresponding renderer. *) + resolution : Gg.v2; (* resolution of the surface. *) backend : cairo_backend; (* final format target. *) mutable size : Size2.t; (* surface dimensions. *) surface : Cairo.Surface.t; (* surface rendered to. *) @@ -320,9 +323,9 @@ let render s v k r = match v with then k r else (Cairo.Surface.finish s.surface; Vgr.Private.flush k r) | `Image (size, view, i) -> - let cw, ch = Size2.w s.size, Size2.h s.size in - if cw = 0.0 || ch = 0.0 - then err_zero_size () ; + let cw = (Size2.w size /. 1000.) *. (V2.x s.resolution) in + let ch = (Size2.h size /. 1000.) *. (V2.y s.resolution) in + if cw = 0.0 || ch = 0.0 then err_zero_size () ; (* Map view rect (bot-left coords) to surface (top-left coords) *) let sx = cw /. Box2.w view in let sy = ch /. Box2.h view in @@ -340,14 +343,15 @@ let render s v k r = match v with init_ctx s; r_image s k r -let format_render ?size backend = +let format_render resolution backend = let s = ref None in fun v k r -> match !s, v with | Some s, _ -> render s v k r | None, `End -> k r | None, `Image (size, view, i) -> - let w, h = Size2.w size, Size2.h size in + let w = (Size2.w size /. 1000.) *. (V2.x resolution) in + let h = (Size2.h size /. 1000.) *. (V2.y resolution) in let surface = match backend with | `PNG -> Cairo.Image.(create ARGB32 (int_of_float w) (int_of_float h)) @@ -358,7 +362,7 @@ let format_render ?size backend = let ctx = Cairo.create surface in Cairo.save ctx; let state = - { r; surface; ctx; size; + { r; surface; ctx; resolution; size; backend = (backend :> cairo_backend); cost = 0; view = Box2.empty; @@ -370,8 +374,8 @@ let format_render ?size backend = s := Some state; render state v k r -let target backend = - let target _ _ = false, format_render backend in +let target ?(resolution = default_resolution) backend = + let target _ _ = false, format_render resolution backend in Vgr.Private.create_target target let target_surface ?size surface = @@ -389,8 +393,9 @@ let target_surface ?size surface = else err_zero_size () in let ctx = Cairo.create surface in Cairo.save ctx; - true, render { r; surface; ctx; - backend = `Surface; size; + true, render { r; surface; ctx; size; + resolution = Size2.v 1.0 1.0; + backend = `Surface; cost = 0; view = Box2.empty; view_tr = M3.id; diff --git a/src/vgr_cairo.mli b/src/vgr_cairo.mli index 0523f81..8019471 100644 --- a/src/vgr_cairo.mli +++ b/src/vgr_cairo.mli @@ -16,9 +16,13 @@ (** {1:target Cairo render targets} *) -val target : [< `PDF | `PNG | `PS | `SVG ] -> Vg.Vgr.dst_stored Vg.Vgr.target -(** [target fmt] is a render target for rendering to the stored destination - given to {!Vg.Vgr.create} in the chosen format [fmt]. +val target : ?resolution:Gg.V2.t -> [< `PDF | `PNG | `PS | `SVG ] -> + Vg.Vgr.dst_stored Vg.Vgr.target +(** [target resolution fmt] is a render target for rendering to the stored + destination given to {!Vg.Vgr.create} in the chosen format [fmt]. + {ul + {- [resolution], specifies the rendering resolution in samples per + meters.}} {b Multiple images.} Multiple images render on the target are not supported. [Invalid_argument] is raised by {!Vg.Vgr.render} if multiple @@ -31,8 +35,8 @@ val target_surface : ?size:Gg.size2 -> Cairo.Surface.t -> {ul {- The physical size of {{!Vg.Vgr.renderable}renderables} is ignored and the view rectangle is mapped on the surface size.} - {- Surfaces created with [Cairo.Surface] have a valid size, while file - based surfaces have a size of zero by default. If the size of the + {- [size], Surfaces created with [Cairo.Surface] have a valid size, while + file based surfaces have a size of zero by default: If the size of the surface can not be determined, the optional argument [size] is used instead. [Invalid_argument] is raised if the size is invalid.}} diff --git a/test/rcairo.ml b/test/rcairo.ml index cec9d5e..84b16cf 100644 --- a/test/rcairo.ml +++ b/test/rcairo.ml @@ -16,9 +16,11 @@ let formats = [ "svg", `SVG; ] +let resolution = V2.v 5000.0 5000.0 + let renderer fmt dst _ = let cairo_fmt = List.assoc fmt formats in - Vgr.create (Vgr_cairo.target cairo_fmt) dst + Vgr.create (Vgr_cairo.target ~resolution cairo_fmt) dst let ftypes = List.map fst formats let () = From 380c4781e96e9c78822af553383e85f63b66c893 Mon Sep 17 00:00:00 2001 From: Arthur Wendling Date: Fri, 12 Dec 2014 22:07:15 +0100 Subject: [PATCH 28/31] Vgr_cairo: update min_cairo example --- test/min_cairo.ml | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/test/min_cairo.ml b/test/min_cairo.ml index 804d984..d8a235b 100644 --- a/test/min_cairo.ml +++ b/test/min_cairo.ml @@ -1,11 +1,11 @@ (* This code is in the public domain. - Minimal Vgr_cairo example. Compile with: + Minimal Vgr_cairo examples. Compile with: ocamlfind ocamlc \ -package cairo2 \ -package gg,vg,vg.cairo2 \ - -linkpkg -o min_cairo2.byte min_cairo2.ml + -linkpkg -o min_cairo.byte min_cairo.ml *) open Gg @@ -22,6 +22,15 @@ let image = I.const (Color.v_srgb 0.314 0.784 0.471) let () = let warn w = Vgr.pp_warning Format.err_formatter w in - let r = Vgr.create ~warn (Vgr_cairo.target `PNG) (`Channel stdout) in + let r = Vgr.create ~warn (Vgr_cairo.target `PS) (`Channel stdout) in + ignore (Vgr.render r (`Image (size, view, image))); + ignore (Vgr.render r `End) + +(* 3. Render with a manually created surface *) + +let () = + let surface = Cairo.Image.(create ARGB32) 400 400 in + let warn w = Vgr.pp_warning Format.err_formatter w in + let r = Vgr.create ~warn (Vgr_cairo.target_surface surface) `Other in ignore (Vgr.render r (`Image (size, view, image))); ignore (Vgr.render r `End) From b687f640135d07d636cc8343d4308c4d3ce506cd Mon Sep 17 00:00:00 2001 From: Arthur Wendling Date: Fri, 12 Dec 2014 22:56:53 +0100 Subject: [PATCH 29/31] Vgr_cairo: documentation, correct resolution --- README.md | 2 +- src/vgr_cairo.ml | 3 ++- src/vgr_cairo.mli | 4 +++- test/rcairo.ml | 4 +--- 4 files changed, 7 insertions(+), 6 deletions(-) diff --git a/README.md b/README.md index 4597f61..1034bc7 100644 --- a/README.md +++ b/README.md @@ -7,7 +7,7 @@ images are values that denote functions mapping points of the cartesian plane to colors. The module provides combinators to define and compose these values. -Renderers for PDF, SVG and the HTML canvas are distributed with the +Renderers for PDF, SVG, Cairo and the HTML canvas are distributed with the module. An API allows to implement new renderers. Vg depends only on [Gg][1]. The SVG renderer has no dependency, the diff --git a/src/vgr_cairo.ml b/src/vgr_cairo.ml index a3ac44b..5ce846a 100644 --- a/src/vgr_cairo.ml +++ b/src/vgr_cairo.ml @@ -12,7 +12,8 @@ open Vgr.Private.Data let err_zero_size () = invalid_arg "Cairo surface has a size of zero" -let default_resolution = Size2.v 1000.0 1000.0 +let default_resolution = + let m = 72000. /. 25.4 in Size2.v m m type cairo_font = Font : 'a Cairo.Font_face.t -> cairo_font type cairo_primitive = Pattern : 'a Cairo.Pattern.t -> cairo_primitive diff --git a/src/vgr_cairo.mli b/src/vgr_cairo.mli index 8019471..257306b 100644 --- a/src/vgr_cairo.mli +++ b/src/vgr_cairo.mli @@ -22,7 +22,9 @@ val target : ?resolution:Gg.V2.t -> [< `PDF | `PNG | `PS | `SVG ] -> destination given to {!Vg.Vgr.create} in the chosen format [fmt]. {ul {- [resolution], specifies the rendering resolution in samples per - meters.}} + meters. The PDF, PS and SVG formats are measured in points by Cairo, + while the PNG format is in pixels. If unspecified, the default + conversion to points is used.}} {b Multiple images.} Multiple images render on the target are not supported. [Invalid_argument] is raised by {!Vg.Vgr.render} if multiple diff --git a/test/rcairo.ml b/test/rcairo.ml index 84b16cf..cec9d5e 100644 --- a/test/rcairo.ml +++ b/test/rcairo.ml @@ -16,11 +16,9 @@ let formats = [ "svg", `SVG; ] -let resolution = V2.v 5000.0 5000.0 - let renderer fmt dst _ = let cairo_fmt = List.assoc fmt formats in - Vgr.create (Vgr_cairo.target ~resolution cairo_fmt) dst + Vgr.create (Vgr_cairo.target cairo_fmt) dst let ftypes = List.map fst formats let () = From 451dbdc06b3eb4eb8ab1eeead5924e98bea55a50 Mon Sep 17 00:00:00 2001 From: Arthur Wendling Date: Mon, 15 Dec 2014 12:11:51 +0100 Subject: [PATCH 30/31] Vgr_cairo: small adjustments --- _tags | 2 ++ src/vgr_cairo.ml | 6 ++---- src/vgr_cairo.mli | 9 +++++---- test/min_cairo.ml | 2 +- test/rcairo.ml | 2 +- test/rstored.ml | 6 +++--- test/tests.itarget | 1 + 7 files changed, 15 insertions(+), 13 deletions(-) diff --git a/_tags b/_tags index 9cf4932..2501d1b 100644 --- a/_tags +++ b/_tags @@ -38,6 +38,8 @@ : package(gg) + : package(gg), package(cairo2) + : package(gg), package(js_of_ocaml), \ package(js_of_ocaml.syntax), syntax(camlp4o) diff --git a/src/vgr_cairo.ml b/src/vgr_cairo.ml index 5ce846a..95af6d3 100644 --- a/src/vgr_cairo.ml +++ b/src/vgr_cairo.ml @@ -178,12 +178,10 @@ let set_stroke s p = s.gstate.g_stroke <- set_source s p let set_fill s p = s.gstate.g_fill <- set_source s p -let set_font s (font, size) = +let set_font s font size = let Font f = get_font s font in Cairo.Font_face.set s.ctx f; Cairo.set_font_size s.ctx size - (*Cairo.set_font_size s.ctx 25.0*) - let set_path s p = let rec loop last = function @@ -252,7 +250,7 @@ let rec r_cut_glyphs s a run i = match run.text with Cairo.save s.ctx; s.todo <- (save_gstate s) :: s.todo; let font_size = run.font.Font.size in - set_font s (run.font, font_size); + set_font s run.font font_size; Cairo.Path.clear s.ctx; M3.(Cairo.transform s.ctx (cairo_matrix 1.0 0.0 0.0 (-1.0) diff --git a/src/vgr_cairo.mli b/src/vgr_cairo.mli index 257306b..c7e228b 100644 --- a/src/vgr_cairo.mli +++ b/src/vgr_cairo.mli @@ -8,9 +8,10 @@ (** Vg Cairo renderer. - {b Dependency:} - {ul {- {e {{:http://forge.ocamlcore.org/projects/cairo/}Cairo2 library - for OCaml}}}} + {b Dependencies:} + {ul {- {e {{:http://forge.ocamlcore.org/projects/cairo/}Cairo2 bindings + for OCaml}}} + {- {e {{:http://cairographics.org/}Cairo Graphics library}}}} {e Release %%VERSION%% — %%MAINTAINER%% } *) @@ -32,7 +33,7 @@ val target : ?resolution:Gg.V2.t -> [< `PDF | `PNG | `PS | `SVG ] -> val target_surface : ?size:Gg.size2 -> Cairo.Surface.t -> [`Other] Vg.Vgr.target -(** [target_surface s] is a render target for rendering to the Cairo +(** [target_surface size s] is a render target for rendering to the Cairo surface [s]. {ul {- The physical size of {{!Vg.Vgr.renderable}renderables} is ignored and diff --git a/test/min_cairo.ml b/test/min_cairo.ml index d8a235b..1fe4e2c 100644 --- a/test/min_cairo.ml +++ b/test/min_cairo.ml @@ -4,7 +4,7 @@ ocamlfind ocamlc \ -package cairo2 \ - -package gg,vg,vg.cairo2 \ + -package gg,vg,vg.cairo \ -linkpkg -o min_cairo.byte min_cairo.ml *) diff --git a/test/rcairo.ml b/test/rcairo.ml index cec9d5e..0b69933 100644 --- a/test/rcairo.ml +++ b/test/rcairo.ml @@ -22,7 +22,7 @@ let renderer fmt dst _ = let ftypes = List.map fst formats let () = - Rstored.main_formats ~no_pack:true "a selected format" ftypes renderer + Rstored.main_multiformats ~no_pack:true "PNG, PDF, PS or SVG" ftypes renderer (*--------------------------------------------------------------------------- Copyright 2014 Arthur Wendling. diff --git a/test/rstored.ml b/test/rstored.ml index d351b5d..4550b5a 100644 --- a/test/rstored.ml +++ b/test/rstored.ml @@ -157,7 +157,7 @@ let pp_image_info ppf i = (* Command line *) -let main_formats ?(no_pack = false) rname ftypes renderer = +let main_multiformats ?(no_pack = false) rname ftypes renderer = let usage = Printf.sprintf "Usage: %s [OPTION]... [ID1] [ID2]...\n\ \ Renders images of the Vg image database to %s files.\n\ @@ -178,7 +178,7 @@ let main_formats ?(no_pack = false) rname ftypes renderer = let usize = ref unix_buffer_size in let nat s r v = if v > 0 then r := v else log "%s must be > 0, ignored\n" s in let options = - (if ftypes = [] then [] else [ + (match ftypes with [] | [_] -> [] | _ -> [ "-format", Arg.Symbol (ftypes, ( := ) ftype), Printf.sprintf "Selects the image format (default: %s)" !ftype ]) @ [ @@ -232,7 +232,7 @@ let main_formats ?(no_pack = false) rname ftypes renderer = List.iter print_endline (List.sort compare tags) let main ?no_pack rname ftype renderer = - main_formats ?no_pack rname [ftype] (fun _ -> renderer) + main_multiformats ?no_pack rname [ftype] (fun _ -> renderer) (*--------------------------------------------------------------------------- Copyright 2013 Daniel C. Bünzli. diff --git a/test/tests.itarget b/test/tests.itarget index f6f2b3f..a930031 100644 --- a/test/tests.itarget +++ b/test/tests.itarget @@ -1,5 +1,6 @@ min_svg.native min_pdf.native +min_cairo.native min_htmlc.byte rsvg.native rpdf.native From a76eb2cf43fd37f98b0533effe50dab109667353 Mon Sep 17 00:00:00 2001 From: Arthur Wendling Date: Mon, 15 Dec 2014 14:21:29 +0100 Subject: [PATCH 31/31] Vgr_cairo: bugfix, bold weight at 700 --- src/vgr_cairo.ml | 8 +++----- src/vgr_cairo.mli | 2 +- 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/src/vgr_cairo.ml b/src/vgr_cairo.ml index 95af6d3..260660b 100644 --- a/src/vgr_cairo.ml +++ b/src/vgr_cairo.ml @@ -161,17 +161,15 @@ let get_font s font = try Hashtbl.find s.fonts font with | `Normal -> Cairo.Upright | `Oblique -> Cairo.Oblique in let weight = match font.Font.weight with - | `W600 | `W700 | `W800 | `W900 -> Cairo.Bold + | `W700 | `W800 | `W900 -> Cairo.Bold | _ -> Cairo.Normal in Font (Cairo.Font_face.create ~family:font.Font.name slant weight) in Hashtbl.add s.fonts font cairo_font; cairo_font let set_source s p = - let p = get_primitive s p in - if s.gstate.g_stroke != p then begin match p with - | Pattern g -> Cairo.set_source s.ctx g - end; + let (Pattern g) as p = get_primitive s p in + Cairo.set_source s.ctx g; p let set_stroke s p = s.gstate.g_stroke <- set_source s p diff --git a/src/vgr_cairo.mli b/src/vgr_cairo.mli index c7e228b..2d7db43 100644 --- a/src/vgr_cairo.mli +++ b/src/vgr_cairo.mli @@ -63,7 +63,7 @@ val target_surface : ?size:Gg.size2 -> Cairo.Surface.t -> [text] must be provided and is used to define the text to render. [font] is used to select the font family. - The weight is limited to Normal ([< `W600]) and Bold ([>= `W600]). *) + The weight is limited to Normal ([< `W700]) and Bold ([>= `W700]). *) (** {1:limits Render warnings and limitations}