(* This file is part of the tutorial http://cairo.forge.ocamlcore.org/tutorial/ *) let pi_4 = atan 1. let two_pi = 8. *. pi_4 let draw_path_moveto cr = Cairo.set_line_width cr 0.1; Cairo.set_source_rgb cr 0. 0. 0.; Cairo.move_to cr 0.25 0.25 let draw_path_lineto cr = draw_path_moveto cr; Cairo.line_to cr 0.5 0.375; Cairo.rel_line_to cr 0.25 (-0.125) let draw_path_arcto cr = draw_path_lineto cr; Cairo.arc cr 0.5 0.5 (0.25 *. sqrt 2.) (-. pi_4) pi_4 let draw_path_curveto cr = draw_path_arcto cr; Cairo.rel_curve_to cr (-0.25) (-0.125) (-0.25) 0.125 (-0.5) 0. let draw_path_close cr = draw_path_curveto cr; Cairo.Path.close cr let draw_textextents cr = let text = "joy" in Cairo.set_font_size cr 0.5; (* Drawing code goes here *) Cairo.set_source_rgb cr 0.0 0.0 0.0; Cairo.select_font_face cr "Georgia" ~weight:Cairo.Bold; let ux, uy = Cairo.device_to_user_distance cr 1. 1. in let px = max ux uy in let fe = Cairo.font_extents cr in let te = Cairo.text_extents cr text in let x = 0.5 -. te.Cairo.x_bearing -. te.Cairo.width /. 2. and y = 0.5 -. fe.Cairo.descent +. fe.Cairo.baseline /. 2. in (* baseline, descent, ascent, height *) Cairo.set_line_width cr (4. *. px); Cairo.set_dash cr [| 9. *. px |]; Cairo.set_source_rgba cr 0. 0.6 0. 0.5; let horizontal_line y = Cairo.move_to cr (x +. te.Cairo.x_bearing) y; Cairo.rel_line_to cr te.Cairo.width 0. in horizontal_line y; horizontal_line (y +. fe.Cairo.descent); horizontal_line (y -. fe.Cairo.ascent); horizontal_line (y -. fe.Cairo.baseline); Cairo.stroke cr; (* extents: width & height (in dashed blue) *) Cairo.set_source_rgba cr 0. 0. 0.75 0.5; Cairo.set_line_width cr px; Cairo.set_dash cr [| 3. *. px |]; Cairo.rectangle cr (x +. te.Cairo.x_bearing) (y +. te.Cairo.y_bearing) te.Cairo.width te.Cairo.height; Cairo.stroke cr; (* text *) Cairo.move_to cr x y; Cairo.set_source_rgb cr 0. 0. 0.; Cairo.show_text cr text; (* bearing (solid blue line) *) Cairo.set_dash cr [| |]; Cairo.set_line_width cr (2. *. px); Cairo.set_source_rgba cr 0. 0. 0.75 0.5; Cairo.move_to cr x y; Cairo.rel_line_to cr te.Cairo.x_bearing te.Cairo.y_bearing; Cairo.stroke cr; (* text's advance (blue dot) *) Cairo.set_source_rgba cr 0. 0. 0.75 0.5; Cairo.arc cr (x +. te.Cairo.x_advance) (y +. te.Cairo.y_advance) (6. *. px) 0. two_pi; Cairo.fill cr; (* reference point (x,y) (red dot) *) Cairo.arc cr x y (6. *. px) 0. two_pi; Cairo.set_source_rgba cr 0.75 0. 0. 0.5; Cairo.fill cr ;; let draw_setsourcegradient cr = let radpat = Cairo.Pattern.create_radial 0.25 0.25 0.1 0.5 0.5 0.5 in Cairo.Pattern.add_color_stop_rgb radpat 1.0 0.8 0.8; Cairo.Pattern.add_color_stop_rgb radpat ~ofs:1. 0.9 0.0 0.0; for i = 1 to 9 do for j = 1 to 9 do Cairo.rectangle cr (float i /. 10.0 -. 0.04) (float j /. 10.0 -. 0.04) 0.08 0.08; done; done; Cairo.set_source cr radpat; Cairo.fill cr; let linpat = Cairo.Pattern.create_linear 0.25 0.35 0.75 0.65 in Cairo.Pattern.add_color_stop_rgba linpat ~ofs:0.00 1. 1. 1. 0.; Cairo.Pattern.add_color_stop_rgba linpat ~ofs:0.25 0. 1. 0. 0.5; Cairo.Pattern.add_color_stop_rgba linpat ~ofs:0.50 1. 1. 1. 0.; Cairo.Pattern.add_color_stop_rgba linpat ~ofs:0.75 0. 0. 1. 0.5; Cairo.Pattern.add_color_stop_rgba linpat ~ofs:1.00 1. 1. 1. 0.; Cairo.rectangle cr 0.0 0.0 1. 1.; Cairo.set_source cr linpat; Cairo.fill cr ;; let get_point = function | Cairo.MOVE_TO(x,y) -> x,y | Cairo.LINE_TO(x,y) -> x,y | Cairo.CURVE_TO(x,y, _,_, _,_) -> x,y | Cairo.CLOSE_PATH -> failwith "get_point" let path_diagram cr = let path = Cairo.Path.to_array(Cairo.Path.copy_flat cr) in let px, py = Cairo.device_to_user_distance cr 3. 3. in Cairo.set_line_width cr (max px py); Cairo.set_source_rgb cr 0. 0.6 0.; Cairo.stroke cr; (* Draw markers at the first and the last point of the path, but only if the path is not closed. If the last path manipulation was a Cairo.Path.close, then we can detect this at the end of the path array. The [CLOSE_PATH] element will be followed by a [MOVE_TO] element (since cairo 1.2.4), so we need to check position [Array.length path - 2]. See the module [Path] for further explanations. *) let len = Array.length path in if len <= 1 || path.(len - 2) <> Cairo.CLOSE_PATH then ( (* Get the first point in the path *) let x, y = get_point path.(0) in let px, py = Cairo.device_to_user_distance cr 5. 5. in let px = max px py in Cairo.arc cr x y px 0. two_pi; Cairo.set_source_rgba cr 0.0 0.6 0.0 0.5; Cairo.fill cr; let x, y = get_point path.(len - 1) in Cairo.arc cr x y px 0. two_pi; Cairo.set_source_rgba cr 0.0 0.0 0.75 0.5; Cairo.fill cr; ) ;; let draw_path_curveto_hints cr = Cairo.save cr; let px, py = Cairo.device_to_user_distance cr 3. 3. in let px = max px py in Cairo.set_source_rgba cr 0.5 0. 0. 0.5; Cairo.Path.sub cr; Cairo.arc cr 0.5 0.625 px 0. two_pi; Cairo.fill cr; Cairo.arc cr 0.5 0.875 px 0. two_pi; Cairo.fill cr; let px, py = Cairo.device_to_user_distance cr 2. 2. in let px = max px py in Cairo.set_line_width cr px; Cairo.set_source_rgba cr 0.5 0. 0. 0.25; Cairo.move_to cr 0.25 0.75; Cairo.rel_line_to cr 0.25 0.125; Cairo.stroke cr; Cairo.move_to cr 0.75 0.75; Cairo.rel_line_to cr (-0.25) (-0.125); Cairo.stroke cr; Cairo.restore cr ;; let draw_setsourcergba cr = Cairo.set_source_rgb cr 0. 0. 0.; Cairo.move_to cr 0. 0.; Cairo.line_to cr 1. 1.; Cairo.move_to cr 1. 0.; Cairo.line_to cr 0. 1.; Cairo.set_line_width cr 0.2; Cairo.stroke cr; Cairo.rectangle cr 0. 0. 0.5 0.5; Cairo.set_source_rgba cr 1. 0. 0. 0.80; Cairo.fill cr; Cairo.rectangle cr 0. 0.5 0.5 0.5; Cairo.set_source_rgba cr 0. 1. 0. 0.60; Cairo.fill cr; Cairo.rectangle cr 0.5 0. 0.5 0.5; Cairo.set_source_rgba cr 0. 0. 1. 0.40; Cairo.fill cr ;; let draw_diagram name cr = (match name with | "setsourcergba" -> draw_setsourcergba cr | "setsourcegradient" -> draw_setsourcegradient cr | "path-moveto" -> draw_path_moveto cr | "path-lineto" -> draw_path_lineto cr | "path-arcto" -> draw_path_arcto cr | "path-curveto" -> draw_path_curveto_hints cr; draw_path_curveto cr | "path-close" -> draw_path_close cr | "textextents" -> draw_textextents cr | _ -> assert false ); if String.sub name 0 5 = "path-" then path_diagram cr let diagram name = let width = 120. and height = 120. in let svg_filename = name ^ ".svg" and png_filename = name ^ ".png" in let surf = Cairo.SVG.create svg_filename width height in let cr = Cairo.create surf in Cairo.scale cr width height; Cairo.set_line_width cr 0.01; Cairo.rectangle cr 0. 0. 1. 1.; Cairo.set_source_rgb cr 1. 1. 1.; Cairo.fill cr; draw_diagram name cr; let ux, uy = Cairo.device_to_user_distance cr 2. 2. in Cairo.set_line_width cr (max ux uy); Cairo.set_source_rgb cr 0. 0. 0.; Cairo.rectangle cr 0. 0. 1. 1.; Cairo.stroke cr; (* write output *) Cairo.PNG.write surf png_filename; Cairo.Surface.finish surf let () = diagram "setsourcergba"; diagram "setsourcegradient"; diagram "path-moveto"; diagram "path-lineto"; diagram "path-arcto"; diagram "path-curveto"; diagram "path-close"; diagram "textextents"