summaryrefslogtreecommitdiff
path: root/test/knockout.ml
diff options
context:
space:
mode:
Diffstat (limited to 'test/knockout.ml')
-rw-r--r--test/knockout.ml162
1 files changed, 70 insertions, 92 deletions
diff --git a/test/knockout.ml b/test/knockout.ml
index dc3f04d..74fff24 100644
--- a/test/knockout.ml
+++ b/test/knockout.ml
@@ -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 ;
-
- Cairo.set_pattern c (Cairo.pattern_create_for_surface check) ;
- rect_path c 0. 0. (float width) (float height) ;
+ 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 ;
+
+ 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 ;
-
- 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 ;
+ fill_checks c 0. 0. width height ;
+
+ 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 ()
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-10 02:19:58 +0000