File: scene.ml

package info (click to toggle)
lablgl 1:1.05-3
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 1,444 kB
  • sloc: ansic: 8,270; ml: 6,118; tcl: 342; makefile: 294; xml: 84; perl: 12
file content (111 lines) | stat: -rw-r--r-- 3,044 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
(* $Id: scene.ml,v 1.12 2001-05-08 01:58:26 garrigue Exp $ *)

(*  Initialize material property and light source.
 *)
let myinit () =
  let light_ambient = 0.0, 0.0, 0.0, 1.0
  and light_diffuse = 1.0, 1.0, 1.0, 1.0
  and light_specular = 1.0, 1.0, 1.0, 1.0
  (*  light_position is NOT default value	*)
  and light_position = 1.0, 1.0, 1.0, 0.0
  in
  GlLight.light ~num:0 (`ambient light_ambient);
  GlLight.light ~num:0 (`diffuse light_diffuse);
  GlLight.light ~num:0 (`specular light_specular);
  GlLight.light ~num:0 (`position light_position);
  
  GlFunc.depth_func `less;
  List.iter Gl.enable [`lighting; `light0; `depth_test]

let pi = acos (-1.)

let solid_torus ~inner ~outer =
  let slices = 32 and faces = 16 in
  let slice_angle = 2.0 *. pi /. float slices
  and face_angle = 2.0 *. pi /. float faces in
  let vertex ~i ~j =
    let angle1 = slice_angle *. float i
    and angle2 = face_angle *. float j in
    GlDraw.normal3 (cos angle1 *. cos angle2,
		    -. sin angle1 *. cos angle2,
		    sin angle2);
    GlDraw.vertex3
      ((outer +. inner *. cos angle2) *. cos angle1,
       -. (outer +. inner *. cos angle2) *. sin angle1,
       inner *. sin angle2)
  in
  GlDraw.begins `quads;
  for i = 0 to slices - 1 do
    for j = 0 to faces - 1 do
      vertex ~i ~j;
      vertex ~i:(i+1) ~j;
      vertex ~i:(i+1) ~j:(j+1);
      vertex ~i ~j:(j+1);
    done
  done;
  GlDraw.ends ()

let solid_cone ~radius ~height =
  GluQuadric.cylinder ~base:radius ~top:0. ~height ~slices:15 ~stacks:10 ()

let solid_sphere ~radius =
  GluQuadric.sphere ~radius ~slices:32 ~stacks:32 ()

let display () =
  GlClear.clear [`color; `depth];

  GlMat.push ();
  GlMat.rotate ~angle:20.0 ~x:1.0 ();

  GlMat.push ();
  GlMat.translate ~x:(-0.75) ~y:0.5 ();
  GlMat.rotate ~angle:90.0 ~x:1.0 ();
  solid_torus ~inner:0.275 ~outer:0.85;
  GlMat.pop ();

  GlMat.push ();
  GlMat.translate ~x:(-0.75) ~y:(-0.5) (); 
  GlMat.rotate ~angle:270.0 ~x:1.0 ();
  solid_cone ~radius:1.0 ~height:2.0;
  GlMat.pop ();

  GlMat.push ();
  GlMat.translate ~x:0.75 ~z:(-1.0) (); 
  solid_sphere ~radius:1.0;
  GlMat.pop ();

  GlMat.pop ();
  Gl.flush ()

let my_reshape ~w ~h =
  GlDraw.viewport ~x:0 ~y:0 ~w ~h;
  GlMat.mode `projection;
  GlMat.load_identity ();
  if w <= h then
    GlMat.ortho ~x:(-2.5,2.5) ~z:(-10.0,10.0)
      ~y:(-2.5 *. float h /. float w, 2.5 *. float h /. float w)
  else 
    GlMat.ortho ~y:(-2.5,2.5) ~z:(-10.0,10.0)
      ~x:(-2.5 *. float w /. float h, 2.5 *. float w /. float h);
  GlMat.mode `modelview

(*  Main Loop
 *  Open window with initial window size, title bar, 
 *  RGBA display mode, and handle input events.
 *)

open Tk

let main () =
  let top = openTk () in
  let togl =
    Togl.create top ~rgba:true ~depth:true ~width:500 ~height:500 in
  Wm.title_set top "Scene";
  myinit ();
  Togl.reshape_func togl
    ~cb:(fun () -> my_reshape ~w:(Togl.width togl) ~h:(Togl.height togl));
  Togl.display_func togl ~cb:display;
  pack [togl] ~expand:true ~fill:`Both;
  mainLoop ()

let _ = Printexc.print main ()