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

« back to all changes in this revision

Viewing changes to Togl/examples/texturesurf.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: texturesurf.ml,v 1.13 2001/05/08 01:58:26 garrigue Exp $ *)
 
2
 
 
3
open StdLabels
 
4
 
 
5
let texpts =
 
6
  [|[|0.0; 0.0;  0.0; 1.0|];
 
7
    [|1.0; 0.0;  1.0; 1.0|]|]
 
8
 
 
9
let ctrlpoints =
 
10
  [|[|-1.5; -1.5; 4.9;  -0.5; -1.5; 2.0;  0.5; -1.5; -1.0; 1.5; -1.5; 2.0|];
 
11
    [|-1.5; -0.5; 1.0;  -0.5; -0.5; 3.0;  0.5; -0.5; 0.0;  1.5; -0.5; -1.0|];
 
12
    [|-1.5; 0.5; 4.0;   -0.5; 0.5; 0.0;   0.5; 0.5; 3.0;   1.5; 0.5; 4.0|];
 
13
    [|-1.5; 1.5; -2.0;  -0.5; 1.5; -2.0;  0.5; 1.5; 0.0;   1.5; 1.5; -1.0|]|]
 
14
 
 
15
let image_width = 64
 
16
and image_height = 64
 
17
 
 
18
let pi = acos (-1.0)
 
19
 
 
20
let display togl =
 
21
  GlClear.clear [`color;`depth];
 
22
  GlDraw.color (1.0,1.0,1.0);
 
23
  GlMap.eval_mesh2 ~mode:`fill ~range1:(0,20) ~range2:(0,20);
 
24
  Gl.flush ();
 
25
  Togl.swap_buffers togl
 
26
 
 
27
let make_image () =
 
28
  let image =
 
29
    GlPix.create `ubyte ~height:image_height ~width:image_width ~format:`rgb in
 
30
  let raw = GlPix.to_raw image
 
31
  and pos = GlPix.raw_pos image in
 
32
  for i = 0 to image_width - 1 do
 
33
    let ti = 2.0 *. pi *. float i /. float image_width in
 
34
    for j = 0 to image_height - 1 do
 
35
      let tj = 2.0 *. pi *. float j /. float image_height in
 
36
      Raw.sets raw ~pos:(pos ~x:j ~y:i)
 
37
        (Array.map ~f:(fun x -> truncate (127.0 *. (1.0 +. x)))
 
38
           [|sin ti; cos (2.0 *. ti); cos (ti +. tj)|]);
 
39
      done;
 
40
  done;
 
41
  image
 
42
 
 
43
let myinit () =
 
44
  let ctrlpoints = Raw.of_matrix ~kind:`double ctrlpoints
 
45
  and texpts = Raw.of_matrix ~kind:`double texpts in
 
46
  GlMap.map2 ~target:`vertex_3
 
47
    (0.0, 1.0) ~order:4 (0.0, 1.0) ~order:4 ctrlpoints;
 
48
  GlMap.map2 ~target:`texture_coord_2
 
49
    (0.0,1.0) ~order:2 (0.0,1.0) ~order:2 texpts;
 
50
  Gl.enable `map2_texture_coord_2;
 
51
  Gl.enable `map2_vertex_3;
 
52
  GlMap.grid2 ~n1:20 ~range1:(0.0,1.0) ~n2:20 ~range2:(0.0,1.0);
 
53
  let image = make_image () in
 
54
  GlTex.env (`mode `decal);
 
55
  List.iter ~f:(GlTex.parameter ~target:`texture_2d)
 
56
    [ `wrap_s `repeat;
 
57
      `wrap_t `repeat;
 
58
      `mag_filter `nearest;
 
59
      `min_filter `nearest ];
 
60
  GlTex.image2d image;
 
61
  List.iter ~f:Gl.enable [`texture_2d;`depth_test;`normalize];
 
62
  GlDraw.shade_model `flat
 
63
 
 
64
let my_reshape togl =
 
65
  let h = Togl.height togl and w = Togl.width togl in
 
66
  GlDraw.viewport ~x:0 ~y:0 ~w ~h;
 
67
  GlMat.mode `projection;
 
68
  GlMat.load_identity ();
 
69
  let r = float h /. float w in
 
70
  if w <= h then
 
71
    GlMat.ortho ~x:(-4.0, 4.0) ~y:(-4.0 *. r, 4.0 *. r) ~z:(-4.0, 4.0)
 
72
  else
 
73
    GlMat.ortho ~x:(-4.0 /. r, 4.0 /. r) ~y:(-4.0, 4.0) ~z:(-4.0, 4.0);
 
74
  GlMat.mode `modelview;
 
75
  GlMat.load_identity ();
 
76
  GlMat.rotate ~angle:85. ~x:1. ~y:1. ~z:1. ()
 
77
 
 
78
open Tk
 
79
 
 
80
let main () =
 
81
  let top = openTk () in
 
82
  let togl =
 
83
    Togl.create top ~rgba:true ~depth:true ~width:300 ~height:300 ~double:true
 
84
  in
 
85
  Wm.title_set top "Texture Surf";
 
86
  myinit ();
 
87
  Togl.reshape_func togl ~cb:(fun () -> my_reshape togl);
 
88
  Togl.display_func togl ~cb:(fun () -> display togl);
 
89
  bind top ~events:[`KeyPress] ~fields:[`KeySymString]
 
90
    ~action:(fun ev ->
 
91
      match ev.ev_KeySymString with
 
92
        "Up" -> GlMat.rotate ~angle:(-5.) ~z:1.0 (); display togl
 
93
      | "Down" -> GlMat.rotate ~angle:(5.) ~z:1.0 (); display togl
 
94
      | "Left" -> GlMat.rotate ~angle:(5.) ~x:1.0 (); display togl
 
95
      | "Right" -> GlMat.rotate ~angle:(-5.) ~x:1.0 (); display togl
 
96
      | "Escape" -> destroy top; exit 0
 
97
      | _ -> ());
 
98
  pack [togl] ~expand:true ~fill:`Both;
 
99
  mainLoop ()
 
100
 
 
101
let _ = main ()