(* $Id: gears.ml,v 1.16 2001/05/08 01:58:25 garrigue Exp $ *)
(*
* 3-D gear wheels. This program is in the public domain.
*
* Brian Paul
* LablGL version by Jacques Garrigue
*)
let pi = acos (-1.)
(*
* Draw a gear wheel. You'll probably want to call this function when
* building a display list since we do a lot of trig here.
*
* Input: inner_radius - radius of hole at center
* outer_radius - radius at center of teeth
* width - width of gear
* teeth - number of teeth
* tooth_depth - depth of tooth
*)
let gear ~inner ~outer ~width ~teeth ~tooth_depth =
let r0 = inner
and r1 = outer -. tooth_depth /. 2.0
and r2 = outer +. tooth_depth /. 2.0 in
let ta = 2.0 *. pi /. float teeth in
let da = ta /. 4.0 in
GlDraw.shade_model `flat;
GlDraw.normal ~z:1.0 ();
let vertex ~r ~z ?(s=0) i =
let angle = float i *. ta +. float s *. da in
GlDraw.vertex ~x:(r *. cos angle) ~y:(r *. sin angle) ~z ()
in
(* draw front face *)
let z = width *. 0.5 in
GlDraw.begins `quad_strip;
for i=0 to teeth do
vertex i ~r:r0 ~z;
vertex i ~r:r1 ~z;
vertex i ~r:r0 ~z;
vertex i ~r:r1 ~z ~s:3;
done;
GlDraw.ends ();
(* draw front sides of teeth *)
GlDraw.begins `quads;
for i=0 to teeth - 1 do
vertex i ~r:r1 ~z;
vertex i ~r:r2 ~s:1 ~z;
vertex i ~r:r2 ~s:2 ~z;
vertex i ~r:r1 ~s:3 ~z;
done;
GlDraw.ends ();
GlDraw.normal ~z:(-1.0) ();
(* draw back face *)
let z = -. width *. 0.5 in
GlDraw.begins `quad_strip;
for i=0 to teeth do
vertex i ~r:r1 ~z;
vertex i ~r:r0 ~z;
vertex i ~r:r1 ~s:3 ~z;
vertex i ~r:r0 ~z;
done;
GlDraw.ends ();
(* draw back sides of teeth *)
GlDraw.begins `quads;
for i=0 to teeth - 1 do
vertex i ~r:r1 ~s:3 ~z;
vertex i ~r:r2 ~s:2 ~z;
vertex i ~r:r2 ~s:1 ~z;
vertex i ~r:r1 ~z;
done;
GlDraw.ends ();
(* draw outward faces of teeth *)
let z = width *. 0.5 and z' = width *. (-0.5) in
GlDraw.begins `quad_strip;
for i=0 to teeth - 1 do
let angle = float i *. ta in
vertex i ~r:r1 ~z;
vertex i ~r:r1 ~z:z';
let u = r2 *. cos(angle+.da) -. r1 *. cos(angle)
and v = r2 *. sin(angle+.da) -. r1 *. sin(angle) in
GlDraw.normal ~x:v ~y:(-.u) ();
vertex i ~r:r2 ~s:1 ~z;
vertex i ~r:r2 ~s:1 ~z:z';
GlDraw.normal ~x:(cos angle) ~y:(sin angle) ();
vertex i ~r:r2 ~s:2 ~z;
vertex i ~r:r2 ~s:2 ~z:z';
let u = r1 *. cos(angle +. 3. *. da) -. r2 *. cos(angle +. 2. *. da)
and v = r1 *. sin(angle +. 3. *. da) -. r2 *. sin(angle +. 2. *. da) in
GlDraw.normal ~x:v ~y:(-.u) ();
vertex i ~r:r1 ~s:3 ~z;
vertex i ~r:r1 ~s:3 ~z:z';
GlDraw.normal ~x:(cos angle) ~y:(sin angle) ();
done;
vertex 0 ~r:r1 ~z;
vertex 0 ~r:r1 ~z:z';
GlDraw.ends ();
GlDraw.shade_model `smooth;
(* draw inside radius cylinder *)
GlDraw.begins `quad_strip;
for i=0 to teeth do
let angle = float i *. ta in
GlDraw.normal ~x:(-. cos angle) ~y:(-. sin angle) ();
vertex i ~r:r0 ~z:z';
vertex i ~r:r0 ~z;
done;
GlDraw.ends ()
class view ~gear1 ~gear2 ~gear3 ?(limit=0) togl = object (self)
val mutable view_rotx = 0.0
val mutable view_roty = 0.0
val mutable view_rotz = 0.0
val mutable angle = 0.0
val mutable count = 1
method rotx a = view_rotx <- a
method roty a = view_roty <- a
method draw =
GlClear.clear [`color;`depth];
GlMat.push ();
GlMat.rotate ~angle:view_rotx ~x:1.0 ();
GlMat.rotate ~angle:view_roty ~y:1.0 ();
GlMat.rotate ~angle:view_rotz ~z:1.0 ();
GlMat.push ();
GlMat.translate ~x:(-3.0) ~y:(-2.0) ();
GlMat.rotate ~angle:angle ~z:1.0 ();
(* gear inner:1.0 outer:4.0 width:1.0 teeth:20 tooth_depth:0.7; *)
GlList.call gear1;
GlMat.pop ();
GlMat.push ();
GlMat.translate ~x:3.1 ~y:(-2.0) ();
GlMat.rotate ~angle:(-2.0 *. angle -. 9.0) ~z:1.0 ();
(* gear inner:0.5 outer:2.0 width:2.0 teeth:10 tooth_depth:0.7; *)
GlList.call gear2;
GlMat.pop ();
GlMat.push ();
GlMat.translate ~x:(-3.1) ~y:4.2 ();
GlMat.rotate ~angle:(-2.0 *. angle -. 25.0) ~z:1.0 ();
(* gear inner:1.3 outer:2.0 width:0.5 teeth:10 tooth_depth:0.7; *)
GlList.call gear3;
GlMat.pop ();
GlMat.pop ();
Togl.swap_buffers togl;
count <- count + 1;
if count =limit then exit 0
method idle =
angle <- angle +. 2.0;
self#draw
method reshape =
let w = Togl.width togl and h = Togl.height togl in
GlDraw.viewport ~x:0 ~y:0 ~w ~h;
GlMat.mode `projection;
GlMat.load_identity ();
let r = float w /. float h in
let r' = 1. /. r in
if (w>h) then
GlMat.frustum ~x:(-. r,r) ~y:(-1.0,1.0) ~z:(5.0,60.0)
else
GlMat.frustum ~x:(-1.0,1.0) ~y:(-.r',r') ~z:(5.0,60.0);
GlMat.mode `modelview;
GlMat.load_identity();
GlMat.translate ~z:(-40.0) ();
GlClear.clear[`color;`depth]
end
let init () =
let pos = 5.0, 5.0, 10.0, 0.0
and red = 0.8, 0.1, 0.0, 1.0
and green = 0.0, 0.8, 0.2, 1.0
and blue = 0.2, 0.2, 1.0, 1.0 in
GlLight.light ~num:0 (`position pos);
List.iter Gl.enable
[`cull_face;`lighting;`light0;`depth_test;`normalize];
(* make the gears *)
let make_gear ~inner ~outer ~width ~teeth ~color =
let list = GlList.create `compile in
GlLight.material ~face:`front (`ambient_and_diffuse color);
gear ~inner ~outer ~width ~teeth ~tooth_depth:0.7;
GlList.ends ();
list
in
let gear1 = make_gear ~inner:1.0 ~outer:4.0 ~width:1.0 ~teeth:20 ~color:red
and gear2 = make_gear ~inner:0.5 ~outer:2.0 ~width:2.0 ~teeth:10 ~color:green
and gear3 = make_gear ~inner:1.3 ~outer:2.0 ~width:0.5 ~teeth:10 ~color:blue in
(gear1, gear2, gear3)
open Tk
let main () =
let top = openTk () in
let f = Frame.create top in
let v = Textvariable.create () in
let my_scale =
Scale.create ~min:0. ~max:180. ~showvalue:false ~highlightbackground:`Black
in
let togl =
Togl.create f ~width:300 ~height:300
~rgba:true ~depth:true ~double:true
and sh = my_scale f ~orient:`Horizontal
and sv = my_scale top ~orient:`Vertical
in
Wm.title_set top "Gears";
let gear1, gear2, gear3 = init() in
let view = new view togl ~gear1 ~gear2 ~gear3 in
Scale.configure sv ~command:(view#rotx);
Scale.configure sh ~command:(view#roty);
Scale.set sh 20.; Scale.set sv 40.;
Togl.reshape_func togl ~cb:(fun () -> view#reshape);
Togl.display_func togl ~cb:(fun () -> view#draw);
Togl.timer_func ~ms:20 ~cb:(fun () -> view#idle);
pack [sv] ~side:`Right ~fill:`Y;
pack [f] ~expand:true ~fill:`Both;
pack [togl] ~side:`Top ~expand:true ~fill:`Both;
pack [sh] ~side:`Bottom ~fill:`X;
Tk.mainLoop ()
let _ = main ()
