glutils.ml

   1 external drawstr : int -> int -> int -> string -> float = "ml_draw_string";;
   2
   3 let traw = Raw.create_static `float ~len:8;;
   4 let vraw = Raw.create_static `float ~len:8;;
   5
   6 let filledrect2 x0 y0 x1 y1 x2 y2 x3 y3 =
   7   Raw.sets_float vraw ~pos:0 [| x0; y0; x1; y1; x2; y2; x3; y3 |];
   8   GlArray.vertex `two vraw;
   9   GlArray.draw_arrays `triangle_strip ~first:0 ~count:4;
  10 ;;
  11
  12 let filledrect1 x0 y0 x1 y1 = filledrect2 x0 y0 x0 y1 x1 y0 x1 y1;;
  13
  14 let filledrect x0 y0 x1 y1 =
  15   GlArray.disable `texture_coord;
  16   filledrect1 x0 y0 x1 y1;
  17   GlArray.enable `texture_coord;
  18 ;;
  19
  20 let linerect x0 y0 x1 y1 =
  21   GlArray.disable `texture_coord;
  22   Raw.sets_float vraw ~pos:0 [| x0; y0; x0; y1; x1; y1; x1; y0 |];
  23   GlArray.vertex `two vraw;
  24   GlArray.draw_arrays `line_loop ~first:0 ~count:4;
  25   GlArray.enable `texture_coord;
  26 ;;
  27
  28 let drawstring size x y s =
  29   Gl.enable `blend;
  30   Gl.enable `texture_2d;
  31   GlFunc.blend_func ~src:`src_alpha ~dst:`one_minus_src_alpha;
  32   ignore (drawstr size x y s);
  33   Gl.disable `blend;
  34   Gl.disable `texture_2d;
  35 ;;
  36
  37 let drawstring1 size x y s =
  38   drawstr size x y s;
  39 ;;
  40
  41 let drawstring2 size x y fmt =
  42   Printf.kprintf (drawstring size (x+1) (y+size+1)) fmt
  43 ;;
  44
  45 let makecheckers () =
  46   (* Based on lablGL-1.04/LablGlut/examples/lablGL/checker.ml which had
  47      following to say:
  48      converted by Issac Trotts.  July 25, 2002 *)
  49   let image = GlPix.create `ubyte ~format:`luminance ~width:2 ~height:2 in
  50   Raw.sets_string (GlPix.to_raw image) ~pos:0 "\255\200\200\255";
  51   let id = GlTex.gen_texture () in
  52   GlTex.bind_texture ~target:`texture_2d id;
  53   GlPix.store (`unpack_alignment 1);
  54   GlTex.image2d image;
  55   List.iter (GlTex.parameter ~target:`texture_2d)
  56             [ `mag_filter `nearest; `min_filter `nearest ];
  57   id;
  58 ;;
  59
  60 let redisplay = ref false;;
  61 let postRedisplay who =
  62   Utils.vlog "redisplay for [%S]" who;
  63   redisplay := true;
  64 ;;