let pi = acos (-1.0) let pi2 = pi +. pi let quality = 64 let height = 2. let piece_len = pi2 /. (float_of_int quality) let name = "Cone" let size = 3.0 let vertices = Array.init (succ quality) (fun i -> if i = 0 then (0., height, 0.) else let arc_len = (float_of_int (i - 1)) *. piece_len in (cos arc_len, 0., sin arc_len)) let rec vect a b = if a >= b then [a] else a::(vect (succ a) b) let rec downvect b a = if b <= a then [b] else b::(downvect (pred b) a) let faces = Array.init (succ quality) (fun i -> if i = 0 then downvect quality 1 else if i = 1 then [0; quality; 1] else [0; pred i; i]) let color = Array.init (succ quality) (fun i -> let a = 0.8 /. (float_of_int quality) *. (float_of_int i) +. 0.2 in a, a, a) let iter2 f a b = let alen = Array.length a and blen = Array.length b in if alen <> blen then raise (Invalid_argument "Array.iter2") else for i = 0 to pred alen do f a.(i) b.(i) done let display () = GlClear.clear [`color]; iter2 (fun face color -> GlDraw.color color; GlDraw.begins `polygon; List.iter (fun i -> GlDraw.vertex3 vertices.(i)) face; GlDraw.ends (); ) faces color; Gl.flush (); Glut.swapBuffers ();; let keyboard ~key ~x ~y = match key with | 27 -> exit 0 | 119 -> GlMat.rotate ~angle: 2.0 ~x:1.0 (); display () (* up *) | 115 -> GlMat.rotate ~angle:(-.2.0) ~x:1.0 (); display () (* down *) | 97 -> GlMat.rotate ~angle: 2.0 ~y:1.0 (); display () (* left *) | 100 -> GlMat.rotate ~angle:(-.2.0) ~y:1.0 (); display () (* right *) | 113 -> GlMat.rotate ~angle: 2.0 ~z:1.0 (); display () (* spin left *) | 101 -> GlMat.rotate ~angle:(-.2.0) ~z:1.0 (); display () (* spin right *) | _ -> Printf.printf "Unknown key: %d\n" key;; let main () = ignore(Glut.init Sys.argv); Glut.initDisplayMode ~alpha:true ~depth:true () ; Glut.initWindowSize ~w:500 ~h:500 ; ignore(Glut.createWindow ~title:name); GlMat.mode `modelview; GlMat.ortho ~x:(-.size, size) ~y:(-.size, size) ~z:(-.size, size); GlDraw.cull_face `back; Gl.enable `cull_face; GlClear.color (0.5, 0.5, 0.5); GlDraw.shade_model `smooth; Glut.displayFunc ~cb:display; Glut.keyboardFunc ~cb:keyboard; Glut.mainLoop () let _ = main ()