File: double.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 (124 lines) | stat: -rw-r--r-- 4,126 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
112
113
114
115
116
117
118
119
120
121
122
123
124
(* $Id: double.ml,v 1.11 2001-05-08 01:58:25 garrigue Exp $ *)

class view togl ~title = object (self)
  val mutable corner_x = 0.
  val mutable corner_y = 0.
  val mutable corner_z = 0.
  val font_base = Togl.load_bitmap_font togl ~font:`Fixed_8x13
  val mutable x_angle = 0.
  val mutable y_angle = 0.
  val mutable z_angle = 0.

  method togl = togl

  method reshape =
    let width = Togl.width togl and height = Togl.height togl in
    let aspect = float width /. float height in
    GlDraw.viewport ~x:0 ~y:0 ~w:width ~h:height;
    (* Set up projection transform *)
    GlMat.mode `projection;
    GlMat.load_identity ();
    GlMat.frustum ~x:(-.aspect, aspect) ~y:(-1.0, 1.0) ~z:(1.0, 10.0);
    corner_x <- -. aspect;
    corner_y <- -1.0;
    corner_z <- -1.1;
    (* Change back to model view transform for rendering *)
    GlMat.mode `modelview

  method print_string s =
    GlList.call_lists ~base:font_base(`byte s) 

  method display =
    GlClear.clear [`color;`depth];
    GlMat.load_identity(); (* Reset modelview matrix to the identity matrix *)
    GlMat.translate ~z:(-3.0) ();         (* Move the camera back three units *)
    GlMat.rotate ~angle:x_angle ~x:1. ();  (* Rotate by X, Y, Z angles *)
    GlMat.rotate ~angle:y_angle ~y:1. ();
    GlMat.rotate ~angle:z_angle ~z:1. ();
    
    Gl.enable `depth_test;

    (* Front face *)
    GlDraw.begins `quads;
    GlDraw.color (0.0, 0.7, 0.1);	(* Green *)
    GlDraw.vertex3 (-1.0, 1.0, 1.0);
    GlDraw.vertex3(1.0, 1.0, 1.0);
    GlDraw.vertex3(1.0, -1.0, 1.0);
    GlDraw.vertex3(-1.0, -1.0, 1.0);
    (* Back face *)
    GlDraw.color (0.9, 1.0, 0.0);   (* Yellow *)
    GlDraw.vertex3(-1.0, 1.0, -1.0);
    GlDraw.vertex3(1.0, 1.0, -1.0);
    GlDraw.vertex3(1.0, -1.0, -1.0);
    GlDraw.vertex3(-1.0, -1.0, -1.0);
    (* Top side face *)
    GlDraw.color (0.2, 0.2, 1.0);   (* Blue *)
    GlDraw.vertex3(-1.0, 1.0, 1.0);
    GlDraw.vertex3(1.0, 1.0, 1.0);
    GlDraw.vertex3(1.0, 1.0, -1.0);
    GlDraw.vertex3(-1.0, 1.0, -1.0);
    (* Bottom side face *)
    GlDraw.color (0.7, 0.0, 0.1);   (* Red *)
    GlDraw.vertex3(-1.0, -1.0, 1.0);
    GlDraw.vertex3(1.0, -1.0, 1.0);
    GlDraw.vertex3(1.0, -1.0, -1.0);
    GlDraw.vertex3(-1.0, -1.0, -1.0);
    GlDraw.ends();
   
    Gl.disable `depth_test;
    GlMat.load_identity();
    GlDraw.color( 1.0, 1.0, 1.0 );
    GlPix.raster_pos ~x:corner_x ~y:corner_y ~z:corner_z ();
    self#print_string title;
    Togl.swap_buffers togl

  method x_angle a = x_angle <- a; Togl.render togl
  method y_angle a = y_angle <- a; Togl.render togl
  method z_angle a = z_angle <- a; Togl.render togl
end

let create_view ~parent ~double =
  new view
    (Togl.create ~width:200 ~height:200 ~depth:true ~rgba:true ~double parent)

open Tk

let main () =
  let top = openTk () in
  let f = Frame.create top in
  let single = create_view ~parent:f ~double:false ~title:"Single buffer"
  and double = create_view ~parent:f ~double:true ~title:"Double buffer" in
  let sx =
    Scale.create ~label:"X Axis" ~min:0. ~max:360. ~orient:`Horizontal
      ~command:(fun x -> single#x_angle x; double#x_angle x) top
  and sy =
    Scale.create ~label:"Y Axis" ~min:0. ~max:360. ~orient:`Horizontal
      ~command:(fun y -> single#y_angle y; double#y_angle y) top
  and button =
    Button.create ~text:"Quit" ~command:(fun () -> destroy top) top
  in

  List.iter
    (fun o ->
      Togl.display_func o#togl ~cb:(fun () -> o#display);
      Togl.reshape_func o#togl ~cb:(fun () -> o#reshape);
      bind o#togl ~events:[`Modified([`Button1],`Motion)]
        ~fields:[`MouseX;`MouseY]
        ~action:(fun ev ->
	  let width = Togl.width o#togl
	  and height =Togl.height o#togl
	  and x = ev.ev_MouseX
	  and y = ev.ev_MouseY in
	  let x_angle = 360. *. float y /. float height
	  and y_angle = 360. *. float (width - x) /. float width in
	  Scale.set sx x_angle;
	  Scale.set sy y_angle))
    [single;double];

  pack ~side:`Left ~padx:3 ~pady:3 ~fill:`Both ~expand:true
    [single#togl; double#togl];
  pack ~fill:`Both ~expand:true [f];
  pack ~fill:`X [coe sx; coe sy; coe button];
  mainLoop ()

let _ = main ()