helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/examples/GL/morph3d.ml

   1 (* $Id$ *)
   2
   3 (*-
   4  * morph3d.c - Shows 3D morphing objects (TK Version)
   5  *
   6  * This program was inspired on a WindowsNT(R)'s screen saver. It was written
   7  * from scratch and it was not based on any other source code.
   8  *
   9  * Porting it to xlock (the final objective of this code since the moment I
  10  * decided to create it) was possible by comparing the original Mesa's gear
  11  * demo with it's ported version, so thanks for Danny Sung for his indirect
  12  * help (look at gear.c in xlock source tree). NOTE: At the moment this code
  13  * was sent to Brian Paul for package inclusion, the XLock Version was not
  14  * available. In fact, I'll wait it to appear on the next Mesa release (If you
  15  * are reading this, it means THIS release) to send it for xlock package
  16  * inclusion). It will probably there be a GLUT version too.
  17  *
  18  * Thanks goes also to Brian Paul for making it possible and inexpensive
  19  * to use OpenGL at home.
  20  *
  21  * Since I'm not a native english speaker, my apologies for any gramatical
  22  * mistake.
  23  *
  24  * My e-mail addresses are
  25  *
  26  * vianna@cat.cbpf.br
  27  *         and
  28  * marcelo@venus.rdc.puc-rio.br
  29  *
  30  * Marcelo F. Vianna (Feb-13-1997)
  31  *)
  32
  33 (*
  34 This document is VERY incomplete, but tries to describe the mathematics used
  35 in the program. At this moment it just describes how the polyhedra are
  36 generated. On futhurer versions, this document will be probabbly improved.
  37
  38 Since I'm not a native english speaker, my apologies for any gramatical
  39 mistake.
  40
  41 Marcelo Fernandes Vianna
  42 - Undergraduate in Computer Engeneering at Catholic Pontifical University
  43 - of Rio de Janeiro (PUC-Rio) Brasil.
  44 - e-mail: vianna@cat.cbpf.br or marcelo@venus.rdc.puc-rio.br
  45 - Feb-13-1997
  46
  47 POLYHEDRA GENERATION
  48
  49 For the purpose of this program it's not sufficient to know the polyhedra
  50 vertexes coordinates. Since the morphing algorithm applies a nonlinear
  51 transformation over the surfaces (faces) of the polyhedron, each face has
  52 to be divided into smaller ones. The morphing algorithm needs to transform
  53 each vertex of these smaller faces individually. It's a very time consoming
  54 task.
  55
  56 In order to reduce calculation overload, and since all the macro faces of
  57 the polyhedron are transformed by the same way, the generation is made by
  58 creating only one face of the polyhedron, morphing it and then rotating it
  59 around the polyhedron center.
  60
  61 What we need to know is the face radius of the polyhedron (the radius of
  62 the inscribed sphere) and the angle between the center of two adjacent
  63 faces using the center of the sphere as the angle's vertex.
  64
  65 The face radius of the regular polyhedra are known values which I decided
  66 to not waste my time calculating. Following is a table of face radius for
  67 the regular polyhedra with edge length = 1:
  68
  69     TETRAHEDRON  : 1/(2*sqrt(2))/sqrt(3)
  70     CUBE         : 1/2
  71     OCTAHEDRON   : 1/sqrt(6)
  72     DODECAHEDRON : T^2 * sqrt((T+2)/5) / 2     -> where T=(sqrt(5)+1)/2
  73     ICOSAHEDRON  : (3*sqrt(3)+sqrt(15))/12
  74
  75 I've not found any reference about the mentioned angles, so I needed to
  76 calculate them, not a trivial task until I figured out how :)
  77 Curiously these angles are the same for the tetrahedron and octahedron.
  78 A way to obtain this value is inscribing the tetrahedron inside the cube
  79 by matching their vertexes. So you'll notice that the remaining unmatched
  80 vertexes are in the same straight line starting in the cube/tetrahedron
  81 center and crossing the center of each tetrahedron's face. At this point
  82 it's easy to obtain the bigger angle of the isosceles triangle formed by
  83 the center of the cube and two opposite vertexes on the same cube face.
  84 The edges of this triangle have the following lenghts: sqrt(2) for the base
  85 and sqrt(3)/2 for the other two other edges. So the angle we want is:
  86      +-----------------------------------------------------------+
  87      | 2*ARCSIN(sqrt(2)/sqrt(3)) = 109.47122063449069174 degrees |
  88      +-----------------------------------------------------------+
  89 For the cube this angle is obvious, but just for formality it can be
  90 easily obtained because we also know it's isosceles edge lenghts:
  91 sqrt(2)/2 for the base and 1/2 for the other two edges. So the angle we
  92 want is:
  93      +-----------------------------------------------------------+
  94      | 2*ARCSIN((sqrt(2)/2)/1)   = 90.000000000000000000 degrees |
  95      +-----------------------------------------------------------+
  96 For the octahedron we use the same idea used for the tetrahedron, but now
  97 we inscribe the cube inside the octahedron so that all cubes's vertexes
  98 matches excatly the center of each octahedron's face. It's now clear that
  99 this angle is the same of the thetrahedron one:
 100      +-----------------------------------------------------------+
 101      | 2*ARCSIN(sqrt(2)/sqrt(3)) = 109.47122063449069174 degrees |
 102      +-----------------------------------------------------------+
 103 For the dodecahedron it's a little bit harder because it's only relationship
 104 with the cube is useless to us. So we need to solve the problem by another
 105 way. The concept of Face radius also exists on 2D polygons with the name
 106 Edge radius:
 107   Edge Radius For Pentagon (ERp)
 108   ERp = (1/2)/TAN(36 degrees) * VRp = 0.6881909602355867905
 109   (VRp is the pentagon's vertex radio).
 110   Face Radius For Dodecahedron
 111   FRd = T^2 * sqrt((T+2)/5) / 2 = 1.1135163644116068404
 112 Why we need ERp? Well, ERp and FRd segments forms a 90 degrees angle,
 113 completing this triangle, the lesser angle is a half of the angle we are
 114 looking for, so this angle is:
 115      +-----------------------------------------------------------+
 116      | 2*ARCTAN(ERp/FRd)         = 63.434948822922009981 degrees |
 117      +-----------------------------------------------------------+
 118 For the icosahedron we can use the same method used for dodecahedron (well
 119 the method used for dodecahedron may be used for all regular polyhedra)
 120   Edge Radius For Triangle (this one is well known: 1/3 of the triangle height)
 121   ERt = sin(60)/3 = sqrt(3)/6 = 0.2886751345948128655
 122   Face Radius For Icosahedron
 123   FRi= (3*sqrt(3)+sqrt(15))/12 = 0.7557613140761707538
 124 So the angle is:
 125      +-----------------------------------------------------------+
 126      | 2*ARCTAN(ERt/FRi)         = 41.810314895778596167 degrees |
 127      +-----------------------------------------------------------+
 128
 129 *)
 130
 131
 132 let scale = 0.3
 133
 134 let vect_mul (x1,y1,z1) (x2,y2,z2) =
 135   (y1 *. z2 -. z1 *. y2, z1 *. x2 -. x1 *. z2, x1 *. y2 -. y1 *. x2)
 136
 137 let sqr a = a *. a
 138
 139 (* Increasing this values produces better image quality, the price is speed. *)
 140 (* Very low values produces erroneous/incorrect plotting *)
 141 let tetradivisions =            23
 142 let cubedivisions =             20
 143 let octadivisions =             21
 144 let dodecadivisions =           10
 145 let icodivisions =              15
 146
 147 let tetraangle =                109.47122063449069174
 148 let cubeangle =                 90.000000000000000000
 149 let octaangle =                 109.47122063449069174
 150 let dodecaangle =               63.434948822922009981
 151 let icoangle =                  41.810314895778596167
 152
 153 let pi = acos (-1.)
 154 let sqrt2 = sqrt 2.
 155 let sqrt3 = sqrt 3.
 156 let sqrt5 = sqrt 5.
 157 let sqrt6 = sqrt 6.
 158 let sqrt15 = sqrt 15.
 159 let cossec36_2 = 0.8506508083520399322
 160 let cosd x =  cos (float x /. 180. *. pi)
 161 let sind x =  sin (float x /. 180. *. pi)
 162 let cos72 = cosd 72
 163 let sin72 = sind 72
 164 let cos36 = cosd 36
 165 let sin36 = sind 36
 166
 167 (*************************************************************************)
 168
 169 let front_shininess =   60.0
 170 let front_specular  =   0.7, 0.7, 0.7, 1.0
 171 let ambient         =   0.0, 0.0, 0.0, 1.0
 172 let diffuse         =   1.0, 1.0, 1.0, 1.0
 173 let position0       =   1.0, 1.0, 1.0, 0.0
 174 let position1       =   -1.0,-1.0, 1.0, 0.0
 175 let lmodel_ambient  =   0.5, 0.5, 0.5, 1.0
 176 let lmodel_twoside  =   true
 177
 178 let materialRed     =   0.7, 0.0, 0.0, 1.0
 179 let materialGreen   =   0.1, 0.5, 0.2, 1.0
 180 let materialBlue    =   0.0, 0.0, 0.7, 1.0
 181 let materialCyan    =   0.2, 0.5, 0.7, 1.0
 182 let materialYellow  =   0.7, 0.7, 0.0, 1.0
 183 let materialMagenta =   0.6, 0.2, 0.5, 1.0
 184 let materialWhite   =   0.7, 0.7, 0.7, 1.0
 185 let materialGray    =   0.2, 0.2, 0.2, 1.0
 186 let all_gray = Array.create 20 materialGray
 187
 188 let vertex ~xf ~yf ~zf ~ampvr2 =
 189   let xa = xf +. 0.01 and yb = yf +. 0.01 in
 190   let xf2 = sqr xf and yf2 = sqr yf in
 191   let factor = 1. -. (xf2 +. yf2) *. ampvr2
 192   and factor1 = 1. -. (sqr xa +. yf2) *. ampvr2
 193   and factor2 = 1. -. (xf2 +. sqr yb) *. ampvr2 in
 194   let vertx = factor *. xf and verty = factor *. yf
 195   and vertz = factor *. zf in
 196   let neiax = factor1 *. xa -. vertx and neiay = factor1 *. yf -. verty
 197   and neiaz = factor1 *. zf -. vertz and neibx = factor2 *. xf -. vertx
 198   and neiby = factor2 *. yb -. verty and neibz = factor2 *. zf -. vertz in
 199   GlDraw.normal3 (vect_mul (neiax, neiay, neiaz) (neibx, neiby, neibz));
 200   GlDraw.vertex3 (vertx, verty, vertz)
 201
 202 let triangle ~edge ~amp ~divisions ~z =
 203   let divi = float divisions in
 204   let vr = edge *. sqrt3 /. 3. in
 205   let ampvr2 = amp /. sqr vr
 206   and zf = edge *. z in
 207   let ax = edge *. (0.5 /. divi)
 208   and ay = edge *. (-0.5 *. sqrt3 /. divi)
 209   and bx = edge *. (-0.5 /. divi) in
 210   for ri = 1 to divisions do
 211     GlDraw.begins `triangle_strip;
 212     for ti = 0 to ri - 1 do
 213       vertex ~zf ~ampvr2
 214         ~xf:(float (ri-ti) *. ax +. float ti *. bx)
 215         ~yf:(vr +. float (ri-ti) *. ay +. float ti *. ay);
 216       vertex ~zf ~ampvr2
 217         ~xf:(float (ri-ti-1) *. ax +. float ti *. bx)
 218         ~yf:(vr +. float (ri-ti-1) *. ay +. float ti *. ay)
 219     done;
 220     vertex ~xf:(float ri *. bx) ~yf:(vr +. float ri *. ay) ~zf ~ampvr2;
 221     GlDraw.ends ()
 222   done
 223
 224 let square ~edge ~amp ~divisions ~z =
 225   let divi = float divisions in
 226   let zf = edge *. z
 227   and ampvr2 = amp /. sqr (edge *. sqrt2 /. 2.) in
 228   for yi = 0 to divisions - 1 do
 229     let yf = edge *. (-0.5 +. float yi /. divi) in
 230     let yf2 = sqr yf in
 231     let y = yf +. 1.0 /. divi *. edge in
 232     let y2 = sqr y in
 233     GlDraw.begins `quad_strip;
 234     for xi = 0 to divisions do
 235       let xf = edge *. (-0.5 +. float xi /. divi) in
 236       vertex ~xf ~yf:y ~zf ~ampvr2;
 237       vertex ~xf ~yf ~zf ~ampvr2
 238     done;
 239     GlDraw.ends ()
 240   done
 241
 242 let pentagon ~edge ~amp ~divisions ~z =
 243   let divi = float divisions in
 244   let zf = edge *. z
 245   and ampvr2 = amp /. sqr(edge *. cossec36_2) in
 246   let x =
 247     Array.init 6
 248       ~f:(fun fi -> -. cos (float fi *. 2. *. pi /. 5. +. pi /. 10.)
 249                      /. divi *. cossec36_2 *. edge)
 250   and y =
 251     Array.init 6
 252       ~f:(fun fi -> sin (float fi *. 2. *. pi /. 5. +. pi /. 10.)
 253                      /. divi *. cossec36_2 *. edge)
 254   in
 255   for ri = 1 to divisions do
 256     for fi = 0 to 4 do
 257       GlDraw.begins `triangle_strip;
 258       for ti = 0 to ri-1 do
 259         vertex ~zf ~ampvr2
 260           ~xf:(float(ri-ti) *. x.(fi) +. float ti *. x.(fi+1))
 261           ~yf:(float(ri-ti) *. y.(fi) +. float ti *. y.(fi+1));
 262         vertex ~zf ~ampvr2
 263           ~xf:(float(ri-ti-1) *. x.(fi) +. float ti *. x.(fi+1))
 264           ~yf:(float(ri-ti-1) *. y.(fi) +. float ti *. y.(fi+1))
 265       done;
 266       vertex ~xf:(float ri *. x.(fi+1)) ~yf:(float ri *. y.(fi+1)) ~zf ~ampvr2;
 267       GlDraw.ends ()
 268     done
 269   done
 270
 271 let call_list list color =
 272   GlLight.material ~face:`both (`diffuse color);
 273   GlList.call list
 274
 275 let draw_tetra ~amp ~divisions ~color =
 276   let list = GlList.create `compile in
 277   triangle ~edge:2.0 ~amp ~divisions ~z:(0.5 /. sqrt6);
 278   GlList.ends();
 279
 280   call_list list color.(0);
 281   GlMat.push();
 282   GlMat.rotate ~angle:180.0 ~z:1.0 ();
 283   GlMat.rotate ~angle:(-.tetraangle) ~x:1.0 ();
 284   call_list list color.(1);
 285   GlMat.pop();
 286   GlMat.push();
 287   GlMat.rotate ~angle:180.0 ~y:1.0 ();
 288   GlMat.rotate ~angle:(-180.0 +. tetraangle) ~x:0.5 ~y:(sqrt3 /. 2.) ();
 289   call_list list color.(2);
 290   GlMat.pop();
 291   GlMat.rotate ~angle:180.0 ~y:1.0 ();
 292   GlMat.rotate ~angle:(-180.0 +. tetraangle) ~x:0.5 ~y:(-.sqrt3 /. 2.) ();
 293   call_list list color.(3);
 294
 295   GlList.delete list
 296
 297 let draw_cube ~amp ~divisions ~color =
 298   let list = GlList.create `compile in
 299   square ~edge:2.0 ~amp ~divisions ~z:0.5;
 300   GlList.ends ();
 301
 302   call_list list color.(0);
 303   for i = 1 to 3 do
 304     GlMat.rotate ~angle:cubeangle ~x:1.0 ();
 305     call_list list color.(i)
 306   done;
 307   GlMat.rotate ~angle:cubeangle ~y:1.0 ();
 308   call_list list color.(4);
 309   GlMat.rotate ~angle:(2.0 *. cubeangle) ~y:1.0 ();
 310   call_list list color.(5);
 311
 312   GlList.delete list
 313
 314 let draw_octa ~amp ~divisions ~color =
 315   let list = GlList.create `compile in
 316   triangle ~edge:2.0 ~amp ~divisions ~z:(1.0 /. sqrt6);
 317   GlList.ends ();
 318
 319   let do_list (i,y) =
 320     GlMat.push();
 321     GlMat.rotate ~angle:180.0 ~y:1.0 ();
 322     GlMat.rotate ~angle:(-.octaangle) ~x:0.5 ~y ();
 323     call_list list color.(i);
 324     GlMat.pop()
 325   in
 326   call_list list color.(0);
 327   GlMat.push();
 328   GlMat.rotate ~angle:180.0 ~z:1.0 ();
 329   GlMat.rotate ~angle:(-180.0 +. octaangle) ~x:1.0 ();
 330   call_list list color.(1);
 331   GlMat.pop();
 332   List.iter [2, sqrt3 /. 2.0; 3, -.sqrt3 /. 2.0] ~f:do_list;
 333   GlMat.rotate ~angle:180.0 ~x:1.0 ();
 334   GlLight.material ~face:`both (`diffuse color.(4));
 335   GlList.call list;
 336   GlMat.push();
 337   GlMat.rotate ~angle:180.0 ~z:1.0 ();
 338   GlMat.rotate ~angle:(-180.0 +. octaangle) ~x:1.0 ();
 339   GlLight.material ~face:`both (`diffuse color.(5));
 340   GlList.call list;
 341   GlMat.pop();
 342   List.iter [6, sqrt3 /. 2.0; 7, -.sqrt3 /. 2.0] ~f:do_list;
 343
 344   GlList.delete list
 345
 346 let draw_dodeca ~amp ~divisions ~color =
 347   let tau = (sqrt5 +. 1.0) /. 2.0 in
 348   let list = GlList.create `compile in
 349   pentagon ~edge:2.0 ~amp ~divisions
 350     ~z:(sqr(tau) *. sqrt ((tau+.2.0)/.5.0) /. 2.0);
 351   GlList.ends ();
 352
 353   let do_list (i,angle,x,y) =
 354     GlMat.push();
 355     GlMat.rotate ~angle:angle ~x ~y ();
 356     call_list list color.(i);
 357     GlMat.pop();
 358   in
 359   GlMat.push ();
 360   call_list list color.(0);
 361   GlMat.rotate ~angle:180.0 ~z:1.0 ();
 362   List.iter ~f:do_list
 363     [ 1, -.dodecaangle, 1.0, 0.0;
 364       2, -.dodecaangle, cos72, sin72;
 365       3, -.dodecaangle, cos72, -.sin72;
 366       4, dodecaangle, cos36, -.sin36;
 367       5, dodecaangle, cos36, sin36 ];
 368   GlMat.pop ();
 369   GlMat.rotate ~angle:180.0 ~x:1.0 ();
 370   call_list list color.(6);
 371   GlMat.rotate ~angle:180.0 ~z:1.0 ();
 372   List.iter ~f:do_list
 373     [ 7, -.dodecaangle, 1.0, 0.0;
 374       8, -.dodecaangle, cos72, sin72;
 375       9, -.dodecaangle, cos72, -.sin72;
 376       10, dodecaangle, cos36, -.sin36 ];
 377   GlMat.rotate ~angle:dodecaangle ~x:cos36 ~y:sin36 ();
 378   call_list list color.(11);
 379
 380   GlList.delete list
 381
 382 let draw_ico ~amp ~divisions ~color =
 383   let list = GlList.create `compile in
 384   triangle ~edge:1.5 ~amp ~divisions
 385     ~z:((3.0 *. sqrt3 +. sqrt15) /. 12.0);
 386   GlList.ends ();
 387
 388   let do_list1 i =
 389     GlMat.rotate ~angle:180.0 ~y:1.0 ();
 390     GlMat.rotate ~angle:(-180.0 +. icoangle) ~x:0.5 ~y:(sqrt3/.2.0) ();
 391     call_list list color.(i)
 392   and do_list2 i =
 393     GlMat.rotate ~angle:180.0 ~y:1.0 ();
 394     GlMat.rotate ~angle:(-180.0 +. icoangle) ~x:0.5 ~y:(-.sqrt3/.2.0) ();
 395     call_list list color.(i)
 396   and do_list3 i =
 397     GlMat.rotate ~angle:180.0 ~z:1.0 ();
 398     GlMat.rotate ~angle:(-.icoangle) ~x:1.0 ();
 399     call_list list color.(i)
 400   in
 401   GlMat.push ();
 402   call_list list color.(0);
 403   GlMat.push ();
 404   do_list3 1;
 405   GlMat.push ();
 406   do_list1 2;
 407   GlMat.pop ();
 408   do_list2 3;
 409   GlMat.pop ();
 410   GlMat.push ();
 411   do_list1 4;
 412   GlMat.push ();
 413   do_list1 5;
 414   GlMat.pop();
 415   do_list3 6;
 416   GlMat.pop ();
 417   do_list2 7;
 418   GlMat.push ();
 419   do_list2 8;
 420   GlMat.pop ();
 421   do_list3 9;
 422   GlMat.pop ();
 423   GlMat.rotate ~angle:180.0 ~x:1.0 ();
 424   call_list list color.(10);
 425   GlMat.push ();
 426   do_list3 11;
 427   GlMat.push ();
 428   do_list1 12;
 429   GlMat.pop ();
 430   do_list2 13;
 431   GlMat.pop ();
 432   GlMat.push ();
 433   do_list1 14;
 434   GlMat.push ();
 435   do_list1 15;
 436   GlMat.pop ();
 437   do_list3 16;
 438   GlMat.pop ();
 439   do_list2 17;
 440   GlMat.push ();
 441   do_list2 18;
 442   GlMat.pop ();
 443   do_list3 19;
 444
 445   GlList.delete list
 446
 447 class view area = object (self)
 448   val area : GlGtk.area = area
 449   val mutable smooth = true
 450   val mutable step = 0.
 451   val mutable obj = 1
 452   val mutable draw_object = fun ~amp -> ()
 453   val mutable magnitude = 0.
 454
 455   method width =  area#misc#allocation.Gtk.width
 456   method height = area#misc#allocation.Gtk.height
 457
 458   method draw () =
 459     let ratio = float self#height /. float self#width in
 460     GlClear.clear [`color;`depth];
 461     GlMat.push();
 462     GlMat.translate ~z:(-10.0) ();
 463     GlMat.scale ~x:(scale *. ratio) ~y:scale ~z:scale ();
 464     GlMat.translate ()
 465       ~x:(2.5 *. ratio *. sin (step *. 1.11))
 466       ~y:(2.5 *. cos (step *. 1.25 *. 1.11));
 467     GlMat.rotate ~angle:(step *. 100.) ~x:1.0 ();
 468     GlMat.rotate ~angle:(step *. 95.) ~y:1.0 ();
 469     GlMat.rotate ~angle:(step *. 90.) ~z:1.0 ();
 470     draw_object ~amp:((sin step +. 1.0/.3.0) *. (4.0/.5.0) *. magnitude);
 471     GlMat.pop();
 472     Gl.flush();
 473     area#swap_buffers ();
 474     step <- step +. 0.05
 475
 476   method reshape ~width ~height =
 477     GlDraw.viewport ~x:0 ~y:0 ~w:width ~h:height;
 478     GlMat.mode `projection;
 479     GlMat.load_identity();
 480     GlMat.frustum ~x:(-1.0, 1.0) ~y:(-1.0, 1.0) ~z:(5.0, 15.0);
 481     GlMat.mode `modelview
 482
 483   method key sym =
 484     begin match sym with
 485       "1" -> obj <- 1
 486     | "2" -> obj <- 2
 487     | "3" -> obj <- 3
 488     | "4" -> obj <- 4
 489     | "5" -> obj <- 5
 490     | "\r" -> smooth <- not smooth
 491     | "\027" -> area#misc#toplevel#destroy (); exit 0
 492     | _ -> ()
 493     end;
 494     self#pinit
 495
 496   method pinit =
 497     begin match obj with
 498       1 ->
 499         draw_object <- draw_tetra
 500              ~divisions:tetradivisions
 501              ~color:[|materialRed;  materialGreen;
 502                      materialBlue; materialWhite|];
 503         magnitude <- 2.5
 504     | 2 ->
 505         draw_object <- draw_cube
 506              ~divisions:cubedivisions
 507              ~color:[|materialRed; materialGreen; materialCyan;
 508                      materialMagenta; materialYellow; materialBlue|];
 509         magnitude <- 2.0
 510     | 3 ->
 511         draw_object <- draw_octa
 512              ~divisions:octadivisions
 513              ~color:[|materialRed; materialGreen; materialBlue;
 514                      materialWhite; materialCyan; materialMagenta;
 515                      materialGray; materialYellow|];
 516         magnitude <- 2.5
 517     | 4 ->
 518       draw_object <- draw_dodeca
 519            ~divisions:dodecadivisions
 520            ~color:[|materialRed; materialGreen; materialCyan;
 521                    materialBlue; materialMagenta; materialYellow;
 522                    materialGreen; materialCyan; materialRed;
 523                    materialMagenta; materialBlue; materialYellow|];
 524       magnitude <- 2.0
 525     | 5 ->
 526         draw_object <- draw_ico
 527              ~divisions:icodivisions
 528              ~color:[|materialRed; materialGreen; materialBlue;
 529                      materialCyan; materialYellow; materialMagenta;
 530                      materialRed; materialGreen; materialBlue;
 531                      materialWhite; materialCyan; materialYellow;
 532                      materialMagenta; materialRed; materialGreen;
 533                      materialBlue; materialCyan; materialYellow;
 534                      materialMagenta; materialGray|];
 535         magnitude <- 3.5
 536     | _ -> ()
 537     end;
 538     GlDraw.shade_model (if smooth then `smooth else `flat)
 539   initializer
 540     area#connect#display ~callback:self#draw;
 541     area#connect#reshape ~callback:self#reshape;
 542     ()
 543 end
 544
 545 open GMain
 546
 547 let main () =
 548   List.iter ~f:print_string
 549     [ "Morph 3D - Shows morphing platonic polyhedra\n";
 550       "Author: Marcelo Fernandes Vianna (vianna@cat.cbpf.br)\n";
 551       "Ported to LablGL by Jacques Garrigue\n\n";
 552       "  [1]    - Tetrahedron\n";
 553       "  [2]    - Hexahedron (Cube)\n";
 554       "  [3]    - Octahedron\n";
 555       "  [4]    - Dodecahedron\n";
 556       "  [5]    - Icosahedron\n";
 557       "[RETURN] - Toggle smooth/flat shading\n";
 558       " [ESC]   - Quit\n" ];
 559   flush stdout;
 560
 561   let window =
 562     GWindow.window ~title:"Morph 3D - Shows morphing platonic polyhedra" ()
 563   in
 564   window#connect#destroy ~callback:Main.quit;
 565   window#set_resize_mode `IMMEDIATE;
 566
 567   let area = GlGtk.area [`DEPTH_SIZE 1;`RGBA;`DOUBLEBUFFER]
 568       ~width:640 ~height:480 ~packing:window#add () in
 569
 570   let view = new view area in
 571
 572   area#connect#realize ~callback:
 573     begin fun () ->
 574       view#pinit;
 575       GlClear.depth 1.0;
 576       GlClear.color (0.0, 0.0, 0.0);
 577       GlDraw.color (1.0, 1.0, 1.0);
 578
 579       GlClear.clear [`color;`depth];
 580       Gl.flush();
 581
 582       List.iter ~f:(GlLight.light ~num:0)
 583         [`ambient ambient; `diffuse diffuse; `position position0];
 584       List.iter ~f:(GlLight.light ~num:1)
 585         [`ambient ambient; `diffuse diffuse; `position position1];
 586       GlLight.light_model (`ambient lmodel_ambient);
 587       GlLight.light_model (`two_side lmodel_twoside);
 588       List.iter ~f:Gl.enable
 589         [`lighting;`light0;`light1;`depth_test;`normalize];
 590
 591       GlLight.material ~face:`both (`shininess front_shininess);
 592       GlLight.material ~face:`both (`specular front_specular);
 593
 594       GlMisc.hint `fog `fastest;
 595       GlMisc.hint `perspective_correction `fastest;
 596       GlMisc.hint `polygon_smooth `fastest
 597     end;
 598
 599   window#event#connect#key_press
 600     ~callback:(fun ev -> view#key (GdkEvent.Key.string ev); true);
 601
 602   Timeout.add ~ms:20
 603     ~callback:(fun _ -> if area#misc#visible then view#draw (); true);
 604   window#show ();
 605   Main.main ()
 606
 607 let _ = main ()