~ubuntu-branches/ubuntu/hardy/lablgl/hardy

« back to all changes in this revision

Viewing changes to LablGlut/examples/lablGL/morph3d.ml

  • Committer: Bazaar Package Importer
  • Author(s): Sven Luther
  • Date: 2004-05-26 09:39:17 UTC
  • Revision ID: james.westby@ubuntu.com-20040526093917-uakgrsrv5keom5kn
Tags: upstream-1.00
ImportĀ upstreamĀ versionĀ 1.00

Show diffs side-by-side

added added

removed removed

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