(* Convex *) (* $Id: convex.ml,v 1.1 2003/01/12 15:33:00 berke Exp $ *) (* By Berke Durak *) open Graphics let m = 128 and n = 128 (* From ``Numerical Recipes in C'', pp.289-290 *) let gaussian = let iset = ref false and gset = ref 0.0 in fun () -> if !iset then begin iset := false; !gset end else begin let rec loop () = let v1 = 2.0 *. (Random.float 1.0) -. 1.0 and v2 = 2.0 *. (Random.float 1.0) -. 1.0 in let rsq = v1 *. v1 +. v2 *. v2 in if rsq >= 1.0 or rsq = 0.0 then loop () else let fac = sqrt (-2.0 *. (log rsq) /. rsq) in gset := v1 *. fac; iset := true; v2 *. fac in loop () end let uniform () = (Random.float 2.0) -. 1.0 (* Convex hull computation *) let pi x y = if x = 0 then y else x let sign x = if x < 0.0 then -1 else if x > 0.0 then 1 else 0 let direct_vector x1 y1 x2 y2 = sign (x1 *. y2 -. x2 *. y1) let direct (_,x1,y1) (_,x2,y2) (_,x3,y3) = direct_vector (x2 -. x1) (y2 -. y1) (x3 -. x1) (y3 -. y1) let f x = int_of_float ((float (m / 2)) +. (float (m / 2)) *. x) and g i = ((float_of_int i) -. (float (m / 2))) /. (float (m / 2)) let dwhl h = match h with [] -> () | (_,x0,y0)::r -> moveto (f x0) (f y0); List.iter (fun (_,x,y) -> lineto (f x) (f y)) r let hull a = let m = Array.length a in if m = 0 then [] else begin let a' = Array.mapi (fun i (x,y) -> (i,x,y)) a in Array.sort (fun (i,x,y) (i',x',y') -> pi (compare x x') (pi (compare y y') (compare i i'))) a'; let lower = [a'.(0)] and upper = [a'.(0)] and (_,_,line) = a'.(0) in let rec loop upper lower i = if i = m then match (lower,List.rev upper) with (x::r,x'::r') -> r@r' | ([],r') -> r' | (r,[]) -> r else let ((_,x,y) as q) = a'.(i) in loop (add_to_half_hull 1 q upper) (add_to_half_hull (-1) q lower) (i + 1) and add_to_half_hull sgn q = function [] -> [q] | [p] -> [q;p] | p::o::r -> if sgn = direct o p q then q::p::o::r else add_to_half_hull sgn q (o::r) in loop upper lower 1 end let square x = x *. x let distance x1 y1 x2 y2 = (square (x1 -. x2)) +. (square (y1 -. y2)) let voronoi cols a m n = Printf.printf "VORONOI\n"; flush stdout; let o = Array.length a in for i = 0 to m - 1 do for j = 0 to n - 1 do let rec loop k d l = if k = o then l else let (x,y) = a.(k) in let d' = distance (g i) (g j) x y in if d' < d then loop (k + 1) d' k else loop (k + 1) d l in let (x,y) = a.(0) in set_color cols.(loop 1 (distance (g i) (g j) x y) 0); plot i j done done let run () = let a = Array.init 128 (fun i -> (uniform () *. 0.75, uniform () *. 0.75)) in auto_synchronize true; let power = ref 0.01 in let cols = Array.init (Array.length a) (fun _ -> rgb (127 + Random.int 128) (127 + Random.int 128) (127 + Random.int 128)) in let randomize () = for i = 1 to Array.length a - 1 do let (x,y) = a.(i) in a.(i) <- (x +. !power *. gaussian (),y +. !power *. gaussian ()) done in let vor = ref false in let button = ref false in while true do let h = hull a in if !vor then voronoi cols a m n else clear_graph (); set_color (rgb 0 0 0); Array.iter (fun (x,y) -> plot (f x) (f y)) a; set_color (rgb 255 0 0); let ctr = ref 0 in begin match h with [] -> () | (i,x0,y0)::r -> moveto (f x0) (f y0); incr ctr; draw_string (Printf.sprintf "%d" !ctr); moveto (f x0) (f y0); let h x y l = lineto (f x) (f y); moveto (f x) (f y); draw_string (Printf.sprintf "%d" l); moveto (f x) (f y) in let rec loop = function [] -> () | [(i,x,y)] -> incr ctr; h x y !ctr; h x0 y0 1 | (i,x,y)::r -> incr ctr; h x y !ctr; loop r in loop r end; synchronize (); let st = wait_next_event (if !button then [Button_up;Key_pressed;Mouse_motion] else [Button_down;Key_pressed]) in let handle_key = function 'P' -> power := !power *. 1.414 | 'p' -> power := !power /. 1.414 | 'r' -> power := 0.01 | 'v' -> vor := not !vor | ' ' -> randomize () | _ -> () in button := st.button; if st.keypressed then begin handle_key st.key; while key_pressed () do handle_key (read_key ()) done; end; if st.button then a.(0) <- (g st.mouse_x, g st.mouse_y) done let _ = open_graph (Printf.sprintf " %dx%d" n m); Random.self_init (); while true do run () done; close_graph ()