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
|
(* $Id: texturesurf.ml,v 1.13 2001/05/08 01:58:26 garrigue Exp $ *)
open StdLabels
let texpts =
[|[|0.0; 0.0; 0.0; 1.0|];
[|1.0; 0.0; 1.0; 1.0|]|]
let ctrlpoints =
[|[|-1.5; -1.5; 4.9; -0.5; -1.5; 2.0; 0.5; -1.5; -1.0; 1.5; -1.5; 2.0|];
[|-1.5; -0.5; 1.0; -0.5; -0.5; 3.0; 0.5; -0.5; 0.0; 1.5; -0.5; -1.0|];
[|-1.5; 0.5; 4.0; -0.5; 0.5; 0.0; 0.5; 0.5; 3.0; 1.5; 0.5; 4.0|];
[|-1.5; 1.5; -2.0; -0.5; 1.5; -2.0; 0.5; 1.5; 0.0; 1.5; 1.5; -1.0|]|]
let image_width = 64
and image_height = 64
let pi = acos (-1.0)
let display togl =
GlClear.clear [`color;`depth];
GlDraw.color (1.0,1.0,1.0);
GlMap.eval_mesh2 ~mode:`fill ~range1:(0,20) ~range2:(0,20);
Gl.flush ();
Togl.swap_buffers togl
let make_image () =
let image =
GlPix.create `ubyte ~height:image_height ~width:image_width ~format:`rgb in
let raw = GlPix.to_raw image
and pos = GlPix.raw_pos image in
for i = 0 to image_width - 1 do
let ti = 2.0 *. pi *. float i /. float image_width in
for j = 0 to image_height - 1 do
let tj = 2.0 *. pi *. float j /. float image_height in
Raw.sets raw ~pos:(pos ~x:j ~y:i)
(Array.map ~f:(fun x -> truncate (127.0 *. (1.0 +. x)))
[|sin ti; cos (2.0 *. ti); cos (ti +. tj)|]);
done;
done;
image
let myinit () =
let ctrlpoints = Raw.of_matrix ~kind:`double ctrlpoints
and texpts = Raw.of_matrix ~kind:`double texpts in
GlMap.map2 ~target:`vertex_3
(0.0, 1.0) ~order:4 (0.0, 1.0) ~order:4 ctrlpoints;
GlMap.map2 ~target:`texture_coord_2
(0.0,1.0) ~order:2 (0.0,1.0) ~order:2 texpts;
Gl.enable `map2_texture_coord_2;
Gl.enable `map2_vertex_3;
GlMap.grid2 ~n1:20 ~range1:(0.0,1.0) ~n2:20 ~range2:(0.0,1.0);
let image = make_image () in
GlTex.env (`mode `decal);
List.iter ~f:(GlTex.parameter ~target:`texture_2d)
[ `wrap_s `repeat;
`wrap_t `repeat;
`mag_filter `nearest;
`min_filter `nearest ];
GlTex.image2d image;
List.iter ~f:Gl.enable [`texture_2d;`depth_test;`normalize];
GlDraw.shade_model `flat
let my_reshape togl =
let h = Togl.height togl and w = Togl.width togl in
GlDraw.viewport ~x:0 ~y:0 ~w ~h;
GlMat.mode `projection;
GlMat.load_identity ();
let r = float h /. float w in
if w <= h then
GlMat.ortho ~x:(-4.0, 4.0) ~y:(-4.0 *. r, 4.0 *. r) ~z:(-4.0, 4.0)
else
GlMat.ortho ~x:(-4.0 /. r, 4.0 /. r) ~y:(-4.0, 4.0) ~z:(-4.0, 4.0);
GlMat.mode `modelview;
GlMat.load_identity ();
GlMat.rotate ~angle:85. ~x:1. ~y:1. ~z:1. ()
open Tk
let main () =
let top = openTk () in
let togl =
Togl.create top ~rgba:true ~depth:true ~width:300 ~height:300 ~double:true
in
Wm.title_set top "Texture Surf";
myinit ();
Togl.reshape_func togl ~cb:(fun () -> my_reshape togl);
Togl.display_func togl ~cb:(fun () -> display togl);
bind top ~events:[`KeyPress] ~fields:[`KeySymString]
~action:(fun ev ->
match ev.ev_KeySymString with
"Up" -> GlMat.rotate ~angle:(-5.) ~z:1.0 (); display togl
| "Down" -> GlMat.rotate ~angle:(5.) ~z:1.0 (); display togl
| "Left" -> GlMat.rotate ~angle:(5.) ~x:1.0 (); display togl
| "Right" -> GlMat.rotate ~angle:(-5.) ~x:1.0 (); display togl
| "Escape" -> destroy top; exit 0
| _ -> ());
pack [togl] ~expand:true ~fill:`Both;
mainLoop ()
let _ =
begin
Printexc.print main ();
if not !Sys.interactive then begin
exit 0;
end;
end;;
|
