← Back to branch summary

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

« back to all changes in this revision

Viewing changes to LablGlut/examples/caml-images/main.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:
LablGlut/examples/caml-images/main.ml
 
1
(* 
 
2
   ciglut : a demo of using caml-images, glut, and opengl to draw a textured
 
3
    rectangle.
 
4
 
 
5
   Copyright (c) 2002 Issac J. Trotts.  LGPL
 
6
*)
 
7
 
 
8
open Image
 
9
open OImage
 
10
open Info
 
11
open Printf
 
12
 
 
13
let width = ref 1
 
14
and height = ref 1;;
 
15
 
 
16
let endl = print_newline;;
 
17
 
 
18
let pow2floor x =
 
19
  let y = ref x in
 
20
  let i = ref 31 in
 
21
  while !i >= 0 && (!y land (1 lsl !i)) == 0 do 
 
22
    i := !i - 1; 
 
23
  done;
 
24
  1 lsl !i;
 
25
;;
 
26
 
 
27
let pow2ceil x = 
 
28
  let p2f = pow2floor x in 
 
29
  if p2f = x then x else (pow2floor x) lsl 1;;
 
30
 
 
31
let i2f i = float_of_int i;;
 
32
let f2i f = int_of_float f;;
 
33
 
 
34
let raw_of_camlimg cimg =
 
35
  let w = cimg#width and h = cimg#height in 
 
36
  let image = GlPix.create `ubyte ~format:`rgb ~width:w ~height:h in
 
37
  for i = 0 to w - 1 do
 
38
    for j = 0 to h - 1 do
 
39
      let pixel = cimg#get i j in (* pixel is a Color.rgb *)
 
40
      Raw.sets (GlPix.to_raw image) ~pos:(3*(i*h+j))
 
41
        [| pixel.r; pixel.g; pixel.b |];
 
42
    done
 
43
  done;
 
44
  image
 
45
;;
 
46
 
 
47
(* scale the image up so it's a power of two along each axis.
 
48
   (IMPROVEME: this takes too long) *)
 
49
let rescale img = 
 
50
  let newimg = img#resize None (pow2ceil img#width) (pow2ceil img#height) in 
 
51
  img#destroy;
 
52
  newimg;;
 
53
 
 
54
let initialize ci_img =
 
55
  printf "initializing..."; endl();
 
56
  GlClear.color (0.0, 0.0, 0.0);
 
57
  (* save the original width and height *)
 
58
  let w = ci_img#width and h = ci_img#height in
 
59
  width := w;
 
60
  height := h;
 
61
  let ci_img = if pow2floor w <> w || pow2floor h <> h 
 
62
                then rescale ci_img else ci_img in
 
63
  let gl_image = raw_of_camlimg ci_img in
 
64
  GlPix.store (`unpack_alignment 1);
 
65
  GlTex.image2d gl_image;
 
66
  List.iter (GlTex.parameter ~target:`texture_2d)
 
67
    [ `wrap_s `clamp;
 
68
      `wrap_t `clamp;
 
69
      `mag_filter `linear;
 
70
      `min_filter `linear ];
 
71
  GlTex.env (`mode `decal);
 
72
  Gl.enable `texture_2d;
 
73
  GlDraw.shade_model `flat;
 
74
  printf "done"; endl();
 
75
;;
 
76
 
 
77
(* -- ui callbacks -- *)
 
78
 
 
79
 
 
80
let disp_called = ref false
 
81
 
 
82
let display () =
 
83
  if not(!disp_called) then begin
 
84
    Glut.reshapeWindow !width !height;
 
85
    GluMat.ortho2d ~x:(0.0, i2f !width) ~y:(0.0, i2f !height);
 
86
    disp_called := true
 
87
  end;
 
88
 
 
89
  GlClear.clear [`color];
 
90
  GlDraw.begins `quads;
 
91
  let w = i2f !width and h = i2f !height in
 
92
  GlTex.coord2(1.0, 0.0); GlDraw.vertex3(0.0, 0.0, 0.0);
 
93
  GlTex.coord2(1.0, 1.0); GlDraw.vertex3(w, 0.0, 0.0);
 
94
  GlTex.coord2(0.0, 1.0); GlDraw.vertex3(w, h, 0.0);
 
95
  GlTex.coord2(0.0, 0.0); GlDraw.vertex3(0.0, h, 0.0);
 
96
  GlDraw.ends();
 
97
 
 
98
  GlDraw.begins `lines;
 
99
  GlDraw.color(1.0, 0.0, 0.0);
 
100
  GlDraw.vertex2(0.0, 0.0);
 
101
  GlDraw.vertex2(1.0, 0.0);
 
102
 
 
103
  GlDraw.color(0.0, 1.0, 0.0);
 
104
  GlDraw.vertex2(0.0, 0.0);
 
105
  GlDraw.vertex2(0.0, 1.0);
 
106
  GlDraw.ends();
 
107
 
 
108
  Gl.flush ();
 
109
 
 
110
;;
 
111
 
 
112
let on_keyboard ~key ~x ~y = 
 
113
  match key with 
 
114
  | 27 -> exit 0;
 
115
  | _ -> ();
 
116
;;
 
117
 
 
118
let view_with_glut img = 
 
119
  (* open a couple of Glut windows and display the file directly
 
120
     and via texture on a square *)
 
121
  ignore(Glut.init Sys.argv);
 
122
  Glut.initDisplayMode ~double_buffer:false ~depth:false ();
 
123
  Glut.initWindowSize 256 256;
 
124
  ignore(Glut.createWindow "ocimgview");
 
125
  GlDraw.shade_model `flat;
 
126
  GlClear.color(0.0,0.0,0.0);
 
127
  (* GluMat.ortho2d ~x:(0.0,1.0) ~y:(0.0,1.0); *)
 
128
  initialize img;
 
129
  Glut.displayFunc (fun () -> display());
 
130
  Glut.keyboardFunc (fun ~key ~x ~y -> on_keyboard ~key ~x ~y);
 
131
  Glut.postRedisplay();
 
132
  Glut.mainLoop();
 
133
;;
 
134
 
 
135
let _ = 
 
136
  Bitmap.maximum_live := 15000000; (* 60MB *)
 
137
  Bitmap.maximum_block_size := !Bitmap.maximum_live / 16;
 
138
  let r = Gc.get () in
 
139
  r.Gc.max_overhead <- 30;
 
140
  Gc.set r
 
141
;;
 
142
 
 
143
let _ =
 
144
  let filename = ref None in
 
145
  let argfmt = [
 
146
    (* "-scale", Arg.Float (fun sc -> scale := sc), "scale"; *)
 
147
  ] in
 
148
  Arg.parse argfmt (fun s -> filename := Some s)
 
149
    "ocimgview file";
 
150
  let filename = match !filename with 
 
151
  | None -> Arg.usage argfmt "ocimgview file"; exit(-1);
 
152
  | Some s -> s 
 
153
  in
 
154
  printf "Reading in %s" filename; endl();
 
155
  let img = OImage.load filename [] in
 
156
  let img = OImage.rgb24 img in
 
157
 
 
158
  view_with_glut img;
 
159
;;
 
160