lablGL/glMisc.ml

   1 (* $Id: glMisc.ml,v 1.8 2008-10-25 02:22:58 garrigue Exp $ *)
   2
   3 open StdLabels
   4
   5 external get_string : [`vendor|`renderer|`version|`extensions] -> string
   6     = "ml_glGetString"
   7
   8 let rec check_substring ~sep ~start ~buf s =
   9   let len = String.length s in
  10   if String.length buf < len + start then false else
  11   if String.sub buf ~pos:start ~len = s &&
  12     (String.length buf = len + start || buf.[len+start] = sep) then true
  13   else match
  14     try Some (String.index_from buf start sep) with Not_found -> None
  15   with
  16   | None -> false
  17   | Some n -> check_substring ~sep ~start:(n+1) ~buf s
  18
  19 let check_extension s =
  20   check_substring ~sep:' ' ~start:0 ~buf:(get_string `extensions) s
  21
  22 type equation = float * float * float * float
  23 external clip_plane : plane:int -> equation -> unit
  24     = "ml_glClipPlane"
  25 let clip_plane ~plane equation =
  26   if plane < 0 || plane > 5 then invalid_arg "Gl.clip_plane";
  27   clip_plane ~plane equation
  28
  29 type hint_target =
  30     [`fog|`line_smooth|`perspective_correction|`point_smooth|`polygon_smooth]
  31 external hint : hint_target -> [`fastest|`nicest|`dont_care] -> unit
  32     = "ml_glHint"
  33
  34 external init_names : unit -> unit = "ml_glInitNames"
  35 external load_name : int -> unit = "ml_glLoadName"
  36 external pop_name : unit -> unit = "ml_glPopName"
  37 external push_name : int -> unit = "ml_glPushName"
  38
  39 external pop_attrib : unit -> unit = "ml_glPopAttrib"
  40 type attrib =
  41     [ `accum_buffer|`color_buffer|`current|`depth_buffer|`enable|`eval|`fog
  42     | `hint|`lighting|`line|`list|`pixel_mode|`point|`polygon|`polygon_stipple
  43     | `scissor|`stencil_buffer|`texture|`transform|`viewport ]
  44 external push_attrib : attrib list -> unit = "ml_glPushAttrib"
  45
  46 external pass_through : float -> unit = "ml_glPassThrough"
  47 external render_mode : [`render|`select|`feedback] -> int = "ml_glRenderMode"
  48 external select_buffer : int -> [`uint] Raw.t -> unit = "ml_glSelectBuffer"
  49 let select_buffer raw =
  50   if not (Raw.static raw) then
  51     invalid_arg "GlMisc.select_buffer : buffer must be static";
  52   select_buffer (Raw.length raw) raw
  53 type feedback_mode =
  54     [`_2d |`_3d |`_3d_color |`_3d_color_texture |`_4d_color_texture]
  55 external feedback_buffer : int -> feedback_mode -> [`float] Raw.t -> unit
  56   = "ml_glFeedbackBuffer"
  57 let feedback_buffer ~mode buf =
  58   if not (Raw.static buf) then
  59     invalid_arg "GlMisc.feedback_buffer : buffer must be static";
  60   feedback_buffer (Raw.length buf) mode buf
  61
  62 external scissor : x:int -> y:int -> width:int -> height:int -> unit
  63   = "ml_glScissor"