[cairo-commit] cairo-ocaml/test text.ml, 1.2, 1.3 svg2png.ml, 1.2,
1.3 spline.ml, 1.4, 1.5 knockout.ml, 1.3, 1.4 kapow.ml, 1.2,
1.3 demo.ml, 1.2, 1.3 basket.ml, 1.4, 1.5 Makefile, 1.7,
1.8 .cvsignore, NONE, 1.1
Olivier Andrieu
commit at pdx.freedesktop.org
Sun May 22 13:03:17 PDT 2005
- Previous message: [cairo-commit] cairo/doc/public/tmpl cairo-atsui.sgml, 1.2,
1.3 cairo-pdf.sgml, 1.6, 1.7 cairo-ps.sgml, 1.3,
1.4 cairo-xcb.sgml, 1.4, 1.5 cairo-xlib.sgml, 1.7,
1.8 cairo.sgml, 1.14, 1.15
- Next message: [cairo-commit]
cairo-ocaml/src svg_cairo.mli, 1.2, 1.3 svg_cairo.ml,
1.2, 1.3 ml_svg_cairo.c, 1.2, 1.3 ml_cairo_wrappers.h, 1.8,
1.9 ml_cairo_wrappers.c, 1.3, 1.4 ml_cairo_surface.c, NONE,
1.1 ml_cairo_status.h, 1.3, NONE ml_cairo_status.c, 1.5,
1.6 ml_cairo_ps.c, NONE, 1.1 ml_cairo_png.c, NONE,
1.1 ml_cairo_pdf.c, NONE, 1.1 ml_cairo_pattern.c, NONE,
1.1 ml_cairo_path.c, 1.3, 1.4 ml_cairo_matrix.c, NONE,
1.1 ml_cairo_lablgtk.c, 1.10, 1.11 ml_cairo_ft.c, 1.5,
1.6 ml_cairo_font.c, NONE, 1.1 ml_cairo_channel.h, 1.2,
NONE ml_cairo_channel.c, 1.4, NONE ml_cairo_bigarr.c, 1.5,
1.6 ml_cairo.h, 1.8, 1.9 ml_cairo.c, 1.20, 1.21 cairo_ps.mli,
NONE, 1.1 cairo_ps.ml, NONE, 1.1 cairo_png.mli, NONE,
1.1 cairo_png.ml, NONE, 1.1 cairo_pdf.mli, NONE,
1.1 cairo_pdf.ml, NONE, 1.1 cairo_lablgtk.mli, 1.4,
1.5 cairo_lablgtk.ml, 1.2, 1.3 cairo_channel.mli, 1.4,
NONE cairo_channel.ml, 1.2, NONE cairo_bigarray.mli, 1.3,
1.4 cairo_bigarray.ml, 1.3, 1.4 cairo.mli, 1.15, 1.16 cairo.ml,
1.13, 1.14 Makefile, 1.9, 1.10
- Messages sorted by:
[ date ]
[ thread ]
[ subject ]
[ author ]
Committed by: oandrieu
Update of /cvs/cairo/cairo-ocaml/test
In directory gabe:/tmp/cvs-serv2640/test
Modified Files:
text.ml svg2png.ml spline.ml knockout.ml kapow.ml demo.ml
basket.ml Makefile
Added Files:
.cvsignore
Log Message:
adapt to cairo big API shakeup
Index: text.ml
===================================================================
RCS file: /cvs/cairo/cairo-ocaml/test/text.ml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- text.ml 2 Mar 2005 18:52:29 -0000 1.2
+++ text.ml 22 May 2005 20:03:15 -0000 1.3
@@ -12,7 +12,7 @@
let box_text cr txt x y =
Cairo.save cr ; begin
let ext = Cairo.text_extents cr text in
- let line_width = Cairo.current_line_width cr in
+ let line_width = Cairo.get_line_width cr in
Cairo.rectangle cr
(x +. ext.Cairo.x_bearing -. line_width)
(y +. ext.Cairo.y_bearing -. line_width)
@@ -23,7 +23,7 @@
Cairo.move_to cr x y ;
Cairo.show_text cr txt ;
Cairo.text_path cr txt ;
- Cairo.set_rgb_color cr 1. 0. 0. ;
+ Cairo.set_source_rgb cr 1. 0. 0. ;
Cairo.set_line_width cr 1.0 ;
Cairo.stroke cr end ;
@@ -33,7 +33,7 @@
let box_glyphs cr gly x y =
Cairo.save cr ; begin
let ext = Cairo.glyph_extents cr gly in
- let line_width = Cairo.current_line_width cr in
+ let line_width = Cairo.get_line_width cr in
Cairo.rectangle cr
(x +. ext.Cairo.x_bearing -. line_width)
(y +. ext.Cairo.y_bearing -. line_width)
@@ -48,26 +48,26 @@
gly in
Cairo.show_glyphs cr gly ;
Cairo.glyph_path cr gly ;
- Cairo.set_rgb_color cr 1. 0. 0. ;
+ Cairo.set_source_rgb cr 1. 0. 0. ;
Cairo.set_line_width cr 1. ;
Cairo.stroke cr end ;
Cairo.restore cr
let draw cr w h =
- Cairo.set_rgb_color cr 0. 0. 0. ;
+ Cairo.set_source_rgb cr 0. 0. 0. ;
Cairo.set_line_width cr 2. ;
Cairo.save cr ; begin
- Cairo.set_rgb_color cr 1. 1. 1. ;
+ Cairo.set_source_rgb cr 1. 1. 1. ;
Cairo.rectangle cr 0. 0. w h ;
- Cairo.set_operator cr Cairo.OPERATOR_SRC ;
+ Cairo.set_operator cr Cairo.OPERATOR_SOURCE ;
Cairo.fill cr end ;
Cairo.restore cr ;
- Cairo.select_font cr "serif" Cairo.FONT_SLANT_NORMAL Cairo.FONT_WEIGHT_NORMAL ;
- Cairo.scale_font cr 40. ;
+ Cairo.select_font_face cr "serif" Cairo.FONT_SLANT_NORMAL Cairo.FONT_WEIGHT_NORMAL ;
+ Cairo.set_font_size cr 40. ;
let { Cairo.font_height = height } as f_ext =
- Cairo.current_font_extents cr in
+ Cairo.font_extents cr in
let glyphs =
begin
@@ -96,9 +96,8 @@
Cairo.translate cr 0. (2. *. height) ;
Cairo.save cr ; begin
- let m = Cairo.matrix_create () in
- Cairo.matrix_rotate m (10. *. atan 1. /. 45.) ;
- Cairo.transform_font cr m ;
+ let m = Cairo.Matrix.init_rotate (10. *. atan 1. /. 45.) in
+ Cairo.set_font_matrix cr m ;
box_text cr text 10. height end ;
Cairo.restore cr ;
@@ -126,8 +125,8 @@
w#connect#destroy GMain.quit ;
let p = GDraw.pixmap ~width ~height ~window:w () in
- let cr = Cairo.create () in
- Cairo_lablgtk.set_target_drawable cr p#pixmap ;
+ let s = Cairo_lablgtk.surface_create p#pixmap in
+ let cr = Cairo.create s in
draw cr (float width) (float height) ;
GMisc.pixmap p ~packing:w#add () ;
Index: svg2png.ml
===================================================================
RCS file: /cvs/cairo/cairo-ocaml/test/svg2png.ml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- svg2png.ml 2 Mar 2005 18:52:29 -0000 1.2
+++ svg2png.ml 22 May 2005 20:03:15 -0000 1.3
@@ -49,37 +49,49 @@
scale = !scale ; width = !width ; height = !height }
let render_to_png args =
- let cr = Cairo.create () in
let svgc = Svg_cairo.create () in
Svg_cairo.parse svgc args.svg_file ;
let svg_width, svg_height = Svg_cairo.get_size svgc in
- let scale, width, height =
- if args.width < 0 && args.height < 0 then
- let width = float svg_width *. args.scale +. 0.5 in
- let height = float svg_height *. args.scale +. 0.5 in
- args.scale, int_of_float width, int_of_float height
- else if args.width < 0 then
- let scale = float args.height /. float svg_height in
- let width = float svg_width *. scale +. 0.5 in
- scale, int_of_float width, args.height
- else if args.height < 0 then
- let scale = float args.width /. float svg_width in
- let height = float svg_height *. scale +. 0.5 in
- scale, args.width, int_of_float height
- else
- let scale = min (float args.height /. float svg_height) (float args.width /. float svg_width) in
- let dx = (float args.width -. (float svg_width *. scale +. 0.5)) /. 2. in
- let dy = (float args.height -. (float svg_height *. scale +. 0.5)) /. 2. in
- Cairo.translate cr dx dy ;
- scale, args.width, args.height in
-
- Cairo.scale cr scale scale ;
- let chan = Cairo_channel.open_out args.png_file in
- Cairo.set_target_png cr chan Cairo.FORMAT_ARGB32 width height ;
- Cairo.set_rgb_color cr 1. 1. 1. ;
+
+ let scale = ref args.scale in
+ let width = ref args.width in
+ let height = ref args.height in
+ let dx = ref 0. in
+ let dy = ref 0. in
+
+ begin
+ if args.width < 0 && args.height < 0 then begin
+ width := int_of_float (float svg_width *. args.scale +. 0.5) ;
+ height := int_of_float (float svg_height *. args.scale +. 0.5)
+ end
+ else if args.width < 0 then begin
+ scale := float args.height /. float svg_height ;
+ width := int_of_float (float svg_width *. args.scale +. 0.5) ;
+ end
+ else if args.height < 0 then begin
+ scale := float args.width /. float svg_width ;
+ height := int_of_float (float svg_height *. args.scale +. 0.5) ;
+ end
+ else begin
+ scale := min (float args.height /. float svg_height) (float args.width /. float svg_width) ;
+ dx := (float args.width -. (float svg_width *. args.scale +. 0.5)) /. 2. ;
+ dy := (float args.height -. (float svg_height *. args.scale +. 0.5)) /. 2.
+ end
+ end ;
+
+ let surf = Cairo.image_surface_create Cairo.FORMAT_ARGB32 !width !height in
+ let cr = Cairo.create surf in
+ Cairo.save cr ; begin
+ Cairo.set_operator cr Cairo.OPERATOR_CLEAR ;
+ Cairo.paint cr end ;
+ Cairo.restore cr ;
+
+ Cairo.translate cr !dx !dy ;
+ Cairo.scale cr !scale !scale ;
+
+ Cairo.set_source_rgb cr 1. 1. 1. ;
Svg_cairo.render svgc cr ;
- Cairo.show_page cr ;
- Cairo_channel.close chan
+ Cairo_png.surface_write_to_file surf args.png_file
let _ =
render_to_png (parse_args ())
Index: spline.ml
===================================================================
RCS file: /cvs/cairo/cairo-ocaml/test/spline.ml,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- spline.ml 2 Mar 2005 18:52:29 -0000 1.4
+++ spline.ml 22 May 2005 20:03:15 -0000 1.5
@@ -7,8 +7,8 @@
(**************************************************************************)
type point = Cairo.point =
- { mutable x : float ;
- mutable y : float }
+ { x : float ;
+ y : float }
type spl = {
mutable pm : GDraw.pixmap ;
@@ -20,7 +20,7 @@
mutable xtrans : float ;
mutable ytrans : float ;
mutable click : bool ;
- drag_pt : point ;
+ mutable drag_pt : point ;
mutable active : int ;
mutable width : int ;
mutable height : int ;
@@ -68,7 +68,7 @@
let draw_control_line cr a b w =
Cairo.save cr ; begin
- Cairo.set_rgb_color cr 0. 0. 1. ;
+ Cairo.set_source_rgb cr 0. 0. 1. ;
Cairo.set_line_width cr w ;
Cairo.move_to cr a.x a.y ;
Cairo.line_to cr b.x b.y ;
@@ -79,7 +79,7 @@
let draw_spline cr spl =
let drag_pt = { x = spl.drag_pt.x ; y = spl.drag_pt.y } in
- Cairo.inverse_transform_point cr drag_pt ;
+ let drag_pt = Cairo.device_to_user cr drag_pt in
Cairo.save cr ; begin
Cairo.move_to cr spl.pt.(0).x spl.pt.(0).y ;
Cairo.curve_to cr
@@ -87,7 +87,7 @@
spl.pt.(2).x spl.pt.(2).y
spl.pt.(3).x spl.pt.(3).y ;
- if spl.click && Cairo.in_stroke cr drag_pt.x drag_pt.y
+ if spl.click && Cairo.in_stroke cr drag_pt
then spl.active <- 0xf ;
Cairo.stroke cr ;
@@ -97,14 +97,13 @@
for i=0 to 3 do
Cairo.save cr ; begin
- Cairo.set_rgb_color cr 1. 0. 0. ;
- Cairo.set_alpha cr 0.5 ;
+ Cairo.set_source_rgba cr 1. 0. 0. 0.5 ;
Cairo.new_path cr ;
Cairo.arc cr
spl.pt.(i).x spl.pt.(i).y
(spl.line_width /. 1.25)
0. two_pi ;
- if spl.click && Cairo.in_fill cr drag_pt.x drag_pt.y
+ if spl.click && Cairo.in_fill cr drag_pt
then begin
spl.active <- 1 lsl i ;
spl.click <- false
@@ -116,10 +115,10 @@
let paint spl =
- let cr = Cairo_lablgtk.create ~target:spl.pm#pixmap () in
+ let cr = Cairo.create (Cairo_lablgtk.surface_create spl.pm#pixmap) in
spl.pm#rectangle ~x:0 ~y:0
~width:spl.width ~height:spl.height ~filled:true () ;
- Cairo.set_rgb_color cr 0. 0. 0. ;
+ Cairo.set_source_rgb cr 0. 0. 0. ;
Cairo.set_line_width cr spl.line_width ;
Cairo.set_line_cap cr spl.line_cap ;
Cairo.translate cr spl.xtrans spl.ytrans ;
@@ -250,8 +249,7 @@
match GdkEvent.get_type ev with
| `BUTTON_PRESS ->
spl.click <- true ;
- spl.drag_pt.x <- GdkEvent.Button.x ev ;
- spl.drag_pt.y <- GdkEvent.Button.y ev ;
+ spl.drag_pt <- { x = GdkEvent.Button.x ev ; y = GdkEvent.Button.y ev } ;
true
| `BUTTON_RELEASE ->
spl.click <- false ;
@@ -265,12 +263,12 @@
for i=0 to 3 do
if (1 lsl i) land spl.active != 0
then begin
- spl.pt.(i).x <- spl.pt.(i).x +. (x -. spl.drag_pt.x) /. spl.zoom ;
- spl.pt.(i).y <- spl.pt.(i).y +. (y -. spl.drag_pt.y) /. spl.zoom
+ let x = spl.pt.(i).x +. (x -. spl.drag_pt.x) /. spl.zoom in
+ let y = spl.pt.(i).y +. (y -. spl.drag_pt.y) /. spl.zoom in
+ spl.pt.(i) <- { x = x ; y = y }
end
done ;
- spl.drag_pt.x <- x ;
- spl.drag_pt.y <- y ;
+ spl.drag_pt <- { x = x ; y = y } ;
refresh da spl ;
true
Index: knockout.ml
===================================================================
RCS file: /cvs/cairo/cairo-ocaml/test/knockout.ml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- knockout.ml 2 Mar 2005 18:52:29 -0000 1.3
+++ knockout.ml 22 May 2005 20:03:15 -0000 1.4
@@ -6,137 +6,115 @@
(* GNU Lesser General Public License version 2.1 (the "LGPL"). *)
(**************************************************************************)
-let rect_path cr x y width height =
- Cairo.new_path cr ;
- Cairo.move_to cr x y ;
- Cairo.rel_line_to cr 0. height ;
- Cairo.rel_line_to cr width 0. ;
- Cairo.rel_line_to cr 0. (~-. height) ;
- Cairo.rel_line_to cr (~-. width) 0. ;
- Cairo.close_path cr
-
-
-
let pi = 4. *. atan 1.
let oval_path cr xc yc xr yr =
- Cairo.new_path cr ;
- Cairo.move_to cr (xc +. xr) yc ;
-
- let tangent_mult = 1.65591 /. 3. in
- for i=0 to 3 do
- let angle1 = (float i /. 2.) *. pi in
- let angle2 = (float (i + 1) /. 2.) *. pi in
-
- let x0 = xc +. xr *. cos angle1 in
- let y0 = yc -. yr *. sin angle1 in
- let x1 = x0 -. xr *. sin angle1 *. tangent_mult in
- let y1 = y0 -. yr *. cos angle1 *. tangent_mult in
- let x3 = xc +. xr *. cos angle2 in
- let y3 = yc -. yr *. sin angle2 in
- let x2 = x3 +. xr *. sin angle2 *. tangent_mult in
- let y2 = y3 +. yr *. cos angle2 *. tangent_mult in
-
- Cairo.curve_to ~cr ~x1 ~y1 ~x2 ~y2 ~x3 ~y3
- done ;
- Cairo.close_path cr
+ let m = Cairo.get_matrix cr in
+ Cairo.translate cr xc yc ;
+ Cairo.scale cr 1. (yr /. xr) ;
+ Cairo.move_to cr xr 0. ;
+ Cairo.arc cr 0. 0. xr 0. (2. *. pi) ;
+ Cairo.close_path cr ;
+ Cairo.set_matrix cr m
let check_size = 32
-let fill_checks c width height =
+let fill_checks c x y width height =
Cairo.save c ; begin
- let check = Cairo.surface_create_similar
- (Cairo.current_target_surface c)
+ let check =
+ Cairo.surface_create_similar
+ (Cairo.get_target c)
Cairo.FORMAT_RGB24 (2 * check_size) (2 * check_size) in
- Cairo.surface_set_repeat check true ;
- Cairo.save c ; begin
+ begin
let f_size = float check_size in
- Cairo.set_target_surface c check ;
- Cairo.set_operator c Cairo.OPERATOR_SRC ;
- Cairo.set_rgb_color c 0.4 0.4 0.4 ;
- rect_path c 0. 0. (2. *. f_size) (2. *. f_size) ;
-
- Cairo.set_rgb_color c 0.7 0.7 0.7 ;
- rect_path c 0. 0. f_size f_size ;
- Cairo.fill c ;
- rect_path c f_size f_size f_size f_size ;
- Cairo.fill c end ;
- Cairo.restore c ;
+ let cr2 = Cairo.create check in
+ Cairo.set_operator cr2 Cairo.OPERATOR_SOURCE ;
+ Cairo.set_source_rgb cr2 0.4 0.4 0.4 ;
+ Cairo.rectangle cr2 0. 0. (2. *. f_size) (2. *. f_size) ;
+ Cairo.fill cr2 ;
+
+ Cairo.set_source_rgb cr2 0.7 0.7 0.7 ;
+ Cairo.rectangle cr2 x y f_size f_size ;
+ Cairo.fill cr2 ;
+ Cairo.rectangle cr2 (x +. f_size) (y +. f_size) f_size f_size ;
+ Cairo.fill cr2
+ end ;
- Cairo.set_pattern c (Cairo.pattern_create_for_surface check) ;
- rect_path c 0. 0. (float width) (float height) ;
+ let pattern = Cairo.Pattern.create_for_surface check in
+ Cairo.Pattern.set_extend pattern Cairo.EXTEND_REPEAT ;
+ Cairo.set_source c pattern ;
+ Cairo.rectangle c 0. 0. (float width) (float height) ;
Cairo.fill c end ;
Cairo.restore c
-let draw_3circles c xc yc radius =
+let draw_3circles c xc yc radius alpha =
let subradius = radius *. (2. /. 3. -. 0.1) in
- List.iter (fun ((r, g, b), off) ->
- Cairo.set_rgb_color c r g b ;
+ List.iter (fun (r, g, b, off) ->
+ Cairo.set_source_rgba c r g b alpha ;
oval_path c
(xc +. radius /. 3. *. cos (pi *. (0.5 +. off)))
(yc -. radius /. 3. *. sin (pi *. (0.5 +. off)))
subradius subradius ;
Cairo.fill c)
- [ (1., 0., 0.), 0. ;
- (0., 1., 0.), 2./.3. ;
- (0., 0., 1.), 4./.3. ; ]
-
+ [ 1., 0., 0., 0. ;
+ 0., 1., 0., 2./.3. ;
+ 0., 0., 1., 4./.3. ; ]
-let expose c d_area ev =
- let { Gtk.width = width ;
- Gtk.height = height } = d_area#misc#allocation in
- let drawable = d_area#misc#window in
+let draw c width height =
let radius = 0.5 *. float (min width height) -. 10. in
let xc = float width /. 2. in
let yc = float height /. 2. in
- Cairo_lablgtk.set_target_drawable c drawable ;
- let sur = Cairo.current_target_surface c in
-
+ let sur = Cairo.get_target c in
let overlay = Cairo.surface_create_similar sur Cairo.FORMAT_ARGB32 width height in
let punch = Cairo.surface_create_similar sur Cairo.FORMAT_A8 width height in
let circles = Cairo.surface_create_similar sur Cairo.FORMAT_ARGB32 width height in
- fill_checks c width height ;
+ fill_checks c 0. 0. width height ;
- Cairo.save c ; begin
- Cairo.set_target_surface c overlay ;
- Cairo.set_rgb_color c 0. 0. 0. ;
- oval_path c xc yc radius radius ;
- Cairo.fill c ;
- Cairo.save c ; begin
- Cairo.set_target_surface c punch ;
- draw_3circles c xc yc radius end ;
- Cairo.restore c ;
- Cairo.set_operator c Cairo.OPERATOR_OUT_REVERSE ;
- Cairo.show_surface c punch width height ;
- Cairo.save c ; begin
- Cairo.set_target_surface c circles ;
- Cairo.set_alpha c 0.5 ;
- Cairo.set_operator c Cairo.OPERATOR_OVER ;
- draw_3circles c xc yc radius end ;
- Cairo.restore c ;
- Cairo.set_operator c Cairo.OPERATOR_ADD ;
- Cairo.show_surface c circles width height end ;
- Cairo.restore c ;
- Cairo.show_surface c overlay width height ;
- true
+ begin
+ let cr_o = Cairo.create overlay in
+ Cairo.set_source_rgb cr_o 0. 0. 0. ;
+ oval_path cr_o xc yc radius radius ;
+ Cairo.fill cr_o ;
+ begin
+ let cr_p = Cairo.create punch in
+ draw_3circles cr_p xc yc radius 1.
+ end ;
+ Cairo.set_operator cr_o Cairo.OPERATOR_DEST_OUT ;
+ Cairo.set_source_surface cr_o punch 0. 0. ;
+ Cairo.paint cr_o ;
+ begin
+ let cr_c = Cairo.create circles in
+ Cairo.set_operator cr_c Cairo.OPERATOR_OVER ;
+ draw_3circles cr_c xc yc radius 0.5
+ end ;
+ Cairo.set_operator cr_o Cairo.OPERATOR_ADD ;
+ Cairo.set_source_surface cr_o circles 0. 0.;
+ Cairo.paint cr_o
+ end ;
+ Cairo.set_source_surface c overlay 0. 0. ;
+ Cairo.paint c
+let expose d_area ev =
+ let c = Cairo.create (Cairo_lablgtk.surface_create d_area#misc#window) in
+ let allocation = d_area#misc#allocation in
+ draw c allocation.Gtk.width allocation.Gtk.height ;
+ true
let main () =
let w = GWindow.window ~title:"Knockout Groups" ~width:400 ~height:400 () in
- w#connect#destroy GMain.quit ;
-
- let c = Cairo.create () in
+ ignore (w#connect#destroy GMain.quit) ;
let d = GMisc.drawing_area ~packing:w#add () in
- d#event#connect#expose (expose c d) ;
+ d#misc#set_double_buffered false ;
+ ignore (d#event#connect#expose (expose d)) ;
w#show () ;
GMain.main ()
Index: kapow.ml
===================================================================
RCS file: /cvs/cairo/cairo-ocaml/test/kapow.ml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- kapow.ml 2 Mar 2005 18:52:29 -0000 1.2
+++ kapow.ml 22 May 2005 20:03:15 -0000 1.3
@@ -63,7 +63,7 @@
Cairo.move_to cr x y ;
Cairo.text_path cr text ;
ignore
- (Cairo.fold_current_path_flat cr
+ (Cairo.fold_path_flat cr
(fun first -> function
| `MOVE_TO p ->
if first then Cairo.new_path cr ;
@@ -75,57 +75,53 @@
true)
let draw text =
- let file = Cairo_channel.open_out filename in
- let cr = Cairo.create () in
- Cairo.set_target_png cr file Cairo.FORMAT_ARGB32 (int_of_float width) (int_of_float height) ;
+ let cr =
+ Cairo.create
+ (Cairo.image_surface_create
+ Cairo.FORMAT_ARGB32
+ (int_of_float width) (int_of_float height))in
Cairo.set_line_width cr 2. ;
Cairo.save cr ; begin
Cairo.translate cr shadow_offset shadow_offset ;
make_star_path cr ;
- Cairo.set_alpha cr 0.5 ;
- Cairo.set_rgb_color cr 0. 0. 0. ;
- Cairo.fill cr ; end ;
+ Cairo.set_source_rgba cr 0. 0. 0. 0.5 ;
+ Cairo.fill cr end ;
Cairo.restore cr ;
make_star_path cr ;
- Cairo.set_alpha cr 1. ;
-
- let pattern = Cairo.pattern_create_radial
+ let pattern = Cairo.Pattern.create_radial
(width /. 2.) (height /. 2.) 10.
(width /. 2.) (height /. 2.) 230. in
- Cairo.pattern_add_color_stop pattern 0. 1. 1. 0.2 1. ;
- Cairo.pattern_add_color_stop pattern 1. 1. 0. 0. 1. ;
- Cairo.set_pattern cr pattern ;
+ Cairo.Pattern.add_color_stop_rgba pattern 0. 1. 1. 0.2 1. ;
+ Cairo.Pattern.add_color_stop_rgba pattern 1. 1. 0. 0. 1. ;
+ Cairo.set_source cr pattern ;
Cairo.fill cr ;
make_star_path cr ;
- Cairo.set_rgb_color cr 0. 0. 0. ;
+ Cairo.set_source_rgb cr 0. 0. 0. ;
Cairo.stroke cr ;
- Cairo.select_font cr fontname Cairo.FONT_SLANT_NORMAL Cairo.FONT_WEIGHT_BOLD ;
- Cairo.scale_font cr 50. ;
+ Cairo.select_font_face cr fontname Cairo.FONT_SLANT_NORMAL Cairo.FONT_WEIGHT_BOLD ;
+ Cairo.set_font_size cr 50. ;
let extents = Cairo.text_extents cr text in
let x = width /. 2. -. (extents.Cairo.text_width /. 2. +. extents.Cairo.x_bearing) in
let y = height /. 2. -. (extents.Cairo.text_height /. 2. +. extents.Cairo.y_bearing) in
make_text_path cr x y text ;
- let pattern = Cairo.pattern_create_linear
+ let pattern = Cairo.Pattern.create_linear
(width /. 2. -. 10.) (height /. 4.)
(width /. 2. +. 10.) (3. *. height /. 4.) in
- Cairo.pattern_add_color_stop pattern 0. 1. 1. 1. 1. ;
- Cairo.pattern_add_color_stop pattern 1. 0. 0. 0.4 1. ;
- Cairo.set_pattern cr pattern ;
+ Cairo.Pattern.add_color_stop_rgba pattern 0. 1. 1. 1. 1. ;
+ Cairo.Pattern.add_color_stop_rgba pattern 1. 0. 0. 0.4 1. ;
+ Cairo.set_source cr pattern ;
Cairo.fill cr ;
make_text_path cr x y text ;
- Cairo.set_rgb_color cr 0. 0. 0. ;
+ Cairo.set_source_rgb cr 0. 0. 0. ;
Cairo.stroke cr ;
- Cairo.show_page cr ;
- Cairo.finalise_target cr ;
-
- Cairo_channel.close file
+ Cairo_png.surface_write_to_file (Cairo.get_target cr) filename
let _ =
draw
Index: demo.ml
===================================================================
RCS file: /cvs/cairo/cairo-ocaml/test/demo.ml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- demo.ml 2 Mar 2005 18:52:29 -0000 1.2
+++ demo.ml 22 May 2005 20:03:15 -0000 1.3
@@ -64,12 +64,11 @@
let width, height = px#size in
px#rectangle ~x:0 ~y:0 ~width ~height ~filled:true ()
end ;
- let cr = Cairo.create () in
- Cairo_lablgtk.set_target_drawable cr px#pixmap ;
- Cairo.set_rgb_color cr 1. 1. 1. ;
+ let cr = Cairo.create (Cairo_lablgtk.surface_create px#pixmap) in
+ Cairo.set_source_rgb cr 1. 1. 1. ;
Cairo.save cr ; begin
- Cairo.scale_font cr 20. ;
+ Cairo.set_font_size cr 20. ;
Cairo.move_to cr 10. 10. ;
Cairo.rotate cr (pi /. 2.) ;
Cairo.show_text cr "Hello World !" end ;
@@ -101,7 +100,7 @@
Cairo.set_line_join cr Cairo.LINE_JOIN_BEVEL ;
draw_shapes cr 0. 0. true ;
- Cairo.set_rgb_color cr 1. 0. 0. ;
+ Cairo.set_source_rgb cr 1. 0. 0. ;
draw_shapes cr 0. 0. false
Index: basket.ml
===================================================================
RCS file: /cvs/cairo/cairo-ocaml/test/basket.ml,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- basket.ml 2 Mar 2005 18:52:29 -0000 1.4
+++ basket.ml 22 May 2005 20:03:15 -0000 1.5
@@ -6,90 +6,88 @@
(* GNU Lesser General Public License version 2.1 (the "LGPL"). *)
(**************************************************************************)
+type point = Cairo.point = { x : float ; y : float }
+
let _ =
Cairo.init
let print_path_elem = function
- | `MOVE_TO { Cairo.x = x ; Cairo.y = y } ->
- Format.printf "@ move_to (%f, %f)" x y
- | `LINE_TO { Cairo.x = x ; Cairo.y = y } ->
- Format.printf "@ line_to (%f, %f)" x y
- | `CURVE_TO ({ Cairo.x = x1 ; Cairo.y = y1 },
- { Cairo.x = x2 ; Cairo.y = y2 },
- { Cairo.x = x3 ; Cairo.y = y3 }) ->
- Format.printf "@ curve_to (%f, %f, %f, %f, %f, %f)" x1 y1 x2 y2 x3 y3
+ | `MOVE_TO p ->
+ Format.printf "@ move_to (%f, %f)" p.x p.y
+ | `LINE_TO p ->
+ Format.printf "@ line_to (%f, %f)" p.x p.y
+ | `CURVE_TO (p1, p2, p3) ->
+ Format.printf "@ curve_to (%f, %f, %f, %f, %f, %f)" p1.x p1.y p2.x p2.y p3.x p3.y
| `CLOSE ->
Format.printf "@ close\n"
let print_path c =
Format.printf "@[<v 2>current_path:" ;
- let nb = Cairo.fold_current_path c
+ let nb = Cairo.fold_path c
(fun nb el -> print_path_elem el ; nb+1) 0 in
Format.printf "@]%d elements at ." nb
let draw ?(print=false) c =
- Cairo.move_to c 10. 10. ;
- Cairo.line_to c 510. 10. ;
- Cairo.curve_to c 410. 200. 110. 200. 10. 10. ;
+ Cairo.move_to c 50. 50. ;
+ Cairo.line_to c 550. 50. ;
+ Cairo.curve_to c 450. 240. 150. 240. 50. 50. ;
Cairo.close_path c ;
if print then print_path c ;
Cairo.save c ; begin
- Cairo.set_rgb_color c 0.8 0.1 0.1 ;
- Cairo.fill c end ;
+ Cairo.set_source_rgb c 0.8 0.1 0.1 ;
+ Cairo.fill_preserve c end ;
Cairo.restore c ;
Cairo.set_line_width c 6. ;
- Cairo.set_rgb_color c 0. 0. 0. ;
+ Cairo.set_source_rgb c 0. 0. 0. ;
Cairo.stroke c
-let width = 520.
-let height = 170.
-let x_inches = width /. 96.
-let y_inches = height /. 96.
-let x_ppi = 300.
-let y_ppi = 300.
+let x_inches = 8.
+let y_inches = 3.
-let main =
- let c = Cairo.create () in
+let main () =
- prerr_endline "PS" ;
begin
- let file = Cairo_channel.open_out "basket.ps" in
- Cairo.set_target_ps c file x_inches y_inches x_ppi y_ppi ;
+ prerr_endline "PS" ;
+ let s = Cairo_ps.surface_create "basket.ps" (x_inches *. 72.) (y_inches *. 72.) in
+ let c = Cairo.create s in
draw ~print:true c ;
Cairo.show_page c ;
- Cairo.finalise_target c ;
- Cairo_channel.close file
+ Cairo.surface_finish s
end ;
- prerr_endline "PDF" ;
begin
- let file = Cairo_channel.open_out "basket.pdf" in
- Cairo.set_target_pdf c file x_inches y_inches x_ppi y_ppi ;
+ prerr_endline "PDF" ;
+ let s = Cairo_pdf.surface_create "basket.pdf" (x_inches *. 72.) (y_inches *. 72.) in
+ let c = Cairo.create s in
draw c ;
Cairo.show_page c ;
- Cairo.finalise_target c ;
- Cairo_channel.close file
+ Cairo.surface_finish s
end ;
- prerr_endline "Bigarray and PPM" ;
begin
- let arr = Bigarray.Array2.create Bigarray.int Bigarray.c_layout
- (int_of_float height) (int_of_float width) in
+ prerr_endline "Bigarray, PPM and PNG" ;
+ let arr =
+ Bigarray.Array2.create Bigarray.int Bigarray.c_layout
+ (int_of_float x_inches * 72) (int_of_float y_inches * 72) in
Bigarray.Array2.fill arr 0xffffff ;
- let img = Cairo_bigarray.of_bigarr_24 arr in
- Cairo.set_target_image c img ;
+ let s = Cairo_bigarray.of_bigarr_24 arr in
+ let c = Cairo.create s in
draw c ;
- let oc = open_out "basket.ppm" in
- Cairo_bigarray.write_ppm_int oc arr ;
- close_out oc
- end ;
+ begin
+ let oc = open_out "basket.ppm" in
+ Cairo_bigarray.write_ppm_int oc arr ;
+ close_out oc
+ end ;
+ Cairo_png.surface_write_to_file s "basket.png"
+ end
- prerr_endline "GdkPixbuf and PNG" ;
+(*
begin
+ prerr_endline "GdkPixbuf and PNG" ;
let pb = GdkPixbuf.create
~width:(int_of_float width)
~height:(int_of_float height) ~bits:8 ~has_alpha:true () in
@@ -100,3 +98,9 @@
Cairo_lablgtk.shuffle_pixels pb ;
GdkPixbuf.save ~filename:"basket.png" ~typ:"png" pb
end
+*)
+
+let () =
+ try main ()
+ with Cairo.Error s ->
+ Printf.eprintf "Fatal error: cairo exception: '%d'\n" (Obj.magic s)
Index: Makefile
===================================================================
RCS file: /cvs/cairo/cairo-ocaml/test/Makefile,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- Makefile 1 Mar 2005 22:19:51 -0000 1.7
+++ Makefile 22 May 2005 20:03:15 -0000 1.8
@@ -1,12 +1,12 @@
include ../config.make
-TARGETS = kapow
+TARGETS = basket kapow
ifdef LABLGTKDIR
-TARGETS += text demo spline basket knockout font
-# ifdef GTKCAIRO_CFLAGS
-# TARGETS += cube
-# endif
+TARGETS += text demo spline knockout # font
+ifdef GTKCAIRO_CFLAGS
+TARGETS += cube
+endif
endif
ifdef LIBSVG_CAIRO_CFLAGS
TARGETS += svg2png
@@ -36,10 +36,13 @@
$(OCAMLOPT) -w s -o $@ -I ../src -I $(LABLGTKDIR) lablgtk.cmxa cairo.cmxa cairo_lablgtk.cmxa gtkInit.cmx $^
basket : basket.ml
- $(OCAMLOPT) -o $@ -I ../src -I $(LABLGTKDIR) bigarray.cmxa cairo.cmxa lablgtk.cmxa cairo_lablgtk.cmxa gtkInit.cmx $^
+ $(OCAMLOPT) -o $@ -I ../src -I $(LABLGTKDIR) bigarray.cmxa cairo.cmxa $^
+
+basket.b : basket.ml
+ $(OCAMLC) -g -o $@ -I ../src -I $(LABLGTKDIR) bigarray.cma cairo.cma $^
knockout : knockout.ml
- $(OCAMLOPT) -w s -o $@ -I ../src -I $(LABLGTKDIR) cairo.cmxa lablgtk.cmxa cairo_lablgtk.cmxa gtkInit.cmx $^
+ $(OCAMLOPT) -o $@ -I ../src -I $(LABLGTKDIR) cairo.cmxa lablgtk.cmxa cairo_lablgtk.cmxa gtkInit.cmx $^
clean :
rm -f *.cm* *.o $(TARGETS) *.ps *.ppm *.png
--- NEW FILE: .cvsignore ---
*.pdf
*.png
*.ps
*.ppm
*.svg
basket
demo
font
kapow
knockout
spline
svg2png
text
- Previous message: [cairo-commit] cairo/doc/public/tmpl cairo-atsui.sgml, 1.2,
1.3 cairo-pdf.sgml, 1.6, 1.7 cairo-ps.sgml, 1.3,
1.4 cairo-xcb.sgml, 1.4, 1.5 cairo-xlib.sgml, 1.7,
1.8 cairo.sgml, 1.14, 1.15
- Next message: [cairo-commit]
cairo-ocaml/src svg_cairo.mli, 1.2, 1.3 svg_cairo.ml,
1.2, 1.3 ml_svg_cairo.c, 1.2, 1.3 ml_cairo_wrappers.h, 1.8,
1.9 ml_cairo_wrappers.c, 1.3, 1.4 ml_cairo_surface.c, NONE,
1.1 ml_cairo_status.h, 1.3, NONE ml_cairo_status.c, 1.5,
1.6 ml_cairo_ps.c, NONE, 1.1 ml_cairo_png.c, NONE,
1.1 ml_cairo_pdf.c, NONE, 1.1 ml_cairo_pattern.c, NONE,
1.1 ml_cairo_path.c, 1.3, 1.4 ml_cairo_matrix.c, NONE,
1.1 ml_cairo_lablgtk.c, 1.10, 1.11 ml_cairo_ft.c, 1.5,
1.6 ml_cairo_font.c, NONE, 1.1 ml_cairo_channel.h, 1.2,
NONE ml_cairo_channel.c, 1.4, NONE ml_cairo_bigarr.c, 1.5,
1.6 ml_cairo.h, 1.8, 1.9 ml_cairo.c, 1.20, 1.21 cairo_ps.mli,
NONE, 1.1 cairo_ps.ml, NONE, 1.1 cairo_png.mli, NONE,
1.1 cairo_png.ml, NONE, 1.1 cairo_pdf.mli, NONE,
1.1 cairo_pdf.ml, NONE, 1.1 cairo_lablgtk.mli, 1.4,
1.5 cairo_lablgtk.ml, 1.2, 1.3 cairo_channel.mli, 1.4,
NONE cairo_channel.ml, 1.2, NONE cairo_bigarray.mli, 1.3,
1.4 cairo_bigarray.ml, 1.3, 1.4 cairo.mli, 1.15, 1.16 cairo.ml,
1.13, 1.14 Makefile, 1.9, 1.10
- Messages sorted by:
[ date ]
[ thread ]
[ subject ]
[ author ]
More information about the cairo-commit
mailing list