lablGL/glMat.ml

   1 (* $Id: glMat.ml,v 1.11 2005-10-28 02:49:09 garrigue Exp $ *)
   2
   3 type t = [`double] Raw.t
   4
   5 external frustum :
   6     x:(float * float) -> y:(float * float) -> z:(float * float) -> unit
   7     = "ml_glFrustum"
   8
   9 external load_identity : unit -> unit = "ml_glLoadIdentity"
  10 external load : t -> unit = "ml_glLoadMatrixd"
  11 let load m =
  12   if Raw.length m <> 16 then invalid_arg "Gl.load_matrix";
  13   load m
  14 external load_transpose : t -> unit = "ml_glLoadTransposeMatrixd"
  15 let load_transpose m =
  16   if Raw.length m <> 16 then invalid_arg "Gl.load_transpose_matrix";
  17   load_transpose m
  18
  19
  20 external get_matrix : [`modelview_matrix|`projection_matrix|`texture_matrix] -> t -> unit = "ml_glGetDoublev"
  21 let get_matrix mode =
  22   let model = Raw.create `double ~len:16 in
  23   get_matrix mode model;
  24   model
  25
  26 external mode : [`modelview|`projection|`texture] -> unit
  27     = "ml_glMatrixMode"
  28 external mult : t -> unit = "ml_glMultMatrixd"
  29 let mult m =
  30   if Raw.length m <> 16 then invalid_arg "Gl.mult_matrix";
  31   mult m
  32 external mult_transpose : t -> unit = "ml_glMultTransposeMatrixd"
  33 let mult_transpose m =
  34   if Raw.length m <> 16 then invalid_arg "Gl.mult_matrix";
  35   mult_transpose m
  36
  37 external ortho :
  38     x:(float * float) -> y:(float * float) -> z:(float * float) -> unit
  39     = "ml_glOrtho"
  40
  41 external pop : unit -> unit = "ml_glPopMatrix"
  42 external push : unit -> unit = "ml_glPushMatrix"
  43
  44 external rotate : angle:float -> x:float -> y:float -> z:float -> unit
  45     = "ml_glRotated"
  46 let rotate3 ~angle (x,y,z) = rotate ~angle ~x ~y ~z
  47 let rotate ~angle ?(x=0.) ?(y=0.) ?(z=0.) () = rotate ~angle ~x ~y ~z
  48
  49 external scale : x:float -> y:float -> z:float -> unit = "ml_glScaled"
  50 let scale3 (x,y,z) = scale ~x ~y ~z
  51 let scale ?(x=0.) ?(y=0.) ?(z=0.) () = scale ~x ~y ~z
  52
  53 external translate : x:float -> y:float -> z:float -> unit = "ml_glTranslated"
  54 let translate3 (x,y,z) = translate ~x ~y ~z
  55 let translate ?(x=0.) ?(y=0.) ?(z=0.) () = translate ~x ~y ~z
  56
  57 let of_raw mat =
  58   if Raw.length mat <> 16 then invalid_arg "GlMatrix.of_array";
  59   mat
  60 external to_raw : t -> [`double] Raw.t = "%identity"
  61
  62 let of_array m : t =
  63   if Array.length m <> 4 then invalid_arg "GlMatrix.of_array";
  64   let mat = Raw.create `double ~len:16 in
  65   for i = 0 to 3 do
  66     let arr = Array.unsafe_get m i in
  67     if Array.length arr <> 4 then invalid_arg "GlMatrix.of_array";
  68     Raw.sets_float mat ~pos:(i*4) arr
  69   done;
  70   mat
  71
  72 let to_array (mat : t) =
  73   let m = Array.create 4 [||] in
  74   for i = 0 to 3 do
  75     Array.unsafe_set m i (Raw.gets_float mat ~pos:(i*4) ~len:4)
  76   done;
  77   m