Source

clutter-ocaml / src / cogl.ml

Full commit
open CoglEnums

type handle
type units = Clutter.units
type angle = Clutter.angle

module Util = struct
  type feature_flag 
  external create_context : unit -> bool = "ml_cogl_create_context"
  external destroy_context : unit -> bool = "ml_cogl_destroy_context"
  external paint_init : Clutter.Color.t -> unit = "ml_cogl_paint_init"
  external check_extension : string -> string -> bool
    = "ml_cogl_check_extension"
  external features_available : feature_flag list -> bool
    = "ml_cogl_features_available"
end
  
    
module Texture = struct
  type vertex = {
    x:units;
    y:units;
    z:units;
    tx:units;
    ty:units;
    color:Clutter.Color.t
  }
  type region =
      (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
    
  exception Cogl_InvalidHandle
  exception Gerror

  external new_with_size : width:int -> height:int -> max_waste:int
    -> auto_mipmap:bool -> format:pixel_format -> handle
    = "ml_cogl_texture_new_with_size"

  external new_from_file : filename:string -> max_waste:int
    -> auto_mipmap:bool -> format:pixel_format -> handle
    = "ml_cogl_texture_new_from_file"

  external new_from_data : width:int -> height:int -> max_waste:int
    -> auto_mipmap:bool -> format:pixel_format -> internal_format:pixel_format
    -> rowstride:int -> data:region -> handle
    = "ml_cogl_texture_new_from_data_bc" "ml_cogl_texture_new_from_data"

  external is_texture : handle -> bool = "ml_cogl_is_texture"
  external width : handle -> int = "ml_cogl_texture_get_width"
  external height : handle -> int = "ml_cogl_texture_get_height"
  external format : handle -> pixel_format = "ml_cogl_texture_get_format"
  external get_rowstride : handle -> int = "ml_cogl_texture_get_rowstride"
  external get_max_waste : handle -> int = "ml_cogl_texture_get_max_waste"

  external _ref : handle -> handle = "ml_cogl_texture_ref"
  external _unref : handle -> unit = "ml_cogl_texture_unref"

  external rectangle : handle -> x1:units -> y1:units -> x2:units -> y2:units
    -> tx1:units -> ty1:units -> tx2:units -> ty2:units -> unit
    = "ml_cogl_texture_rectangle_bc" "ml_cogl_texture_rectangle"
  external polygon : handle -> vertices:vertex array
    -> use_color:bool -> unit = "ml_cogl_texture_polygon"
      
end

module Path = struct
  external fill : unit -> unit = "ml_cogl_path_fill"
  external stroke : unit -> unit = "ml_cogl_path_stroke"
  external move_to : x:units -> y:units -> unit = "ml_cogl_path_move_to"
  external close : unit -> unit = "ml_cogl_close"
  external line_to : x:units -> y:units -> unit = "ml_cogl_path_line_to"
  external curve_to : x1:units -> y1:units -> x2:units -> y2:units ->
    x3:units -> y3:units -> unit = "ml_cogl_path_curve_to_bc" "ml_cogl_path_curve_to"
    (* FIXME: find out type of angle *)
  external arc : cx:units -> cy:units -> rx:units -> ry:units -> angle1:angle ->
    angle2:angle -> unit = "ml_cogl_path_arc_bc" "ml_cogl_path_arc"
  external rel_move_to : x:units -> y:units -> unit = "ml_cogl_path_rel_move_to"
  external rel_line_to : x:units -> y:units -> unit = "ml_cogl_path_rel_line_to"
  external rel_curve_to : x1:units -> y1:units -> x2:units ->
    y2:units -> x3:units -> y3:units -> unit
    = "ml_cogl_path_rel_curve_to_bc" "ml_cogl_path_rel_curve_to"
  external line : x1:units -> y1:units -> x2:units -> y2:units -> unit
    = "ml_cogl_path_line"
  external polyline : units array -> unit = "ml_cogl_path_polyline"
  external polygon : units array -> unit = "ml_cogl_path_polygon"
  external rectangle : x:units -> y:units -> width:units
    -> height:units -> unit = "ml_cogl_path_rectangle"
  external round_rectangle : x:units -> y:units -> width:units ->
    height:units -> radius:units -> arc_step:angle -> unit
    = "ml_cogl_path_round_rectangle_bc" "ml_cogl_path_round_rectangle"
  external ellipse : cx:units -> cy:units -> rx:units -> ry:units -> unit
    = "ml_cogl_path_ellipse"
end

module Offscreen = struct
end

external color : Clutter.Color.t -> unit = "ml_cogl_color"
external rectangle : x:int -> y:int -> width:int -> height:int -> unit
  = "ml_cogl_rectangle"
external rectanglex : x:units -> y:units -> width:units -> height:units -> unit
  = "ml_cogl_rectanglex"
external perspective : fovy:units -> aspect:units -> z_near:units ->
  z_far:units -> unit = "ml_cogl_perspective"
external setup_viewport : width:units -> height:units -> fovy:units ->
  aspect:units -> z_near:units -> z_far:units -> unit
  = "ml_cogl_setup_viewport_bc" "ml_cogl_setup_viewport"
  (* FIXME: these are actually 4x4 arrays *)
external get_modelview_matrix : unit -> units array
  = "ml_cogl_get_modelview_matrix"
external get_projection_matrix : unit -> units array
  = "ml_cogl_get_projection_matrix"
external get_viewport : unit -> (units*units*units*units) = "ml_cogl_get_viewport"
external push_matrix : unit -> unit = "ml_cogl_push_matrix"
external pop_matrix : unit -> unit = "ml_cogl_pop_matrix"
external scale : x:units -> y:units -> unit = "ml_cogl_scale"
external translatex : x:units -> y:units -> z:units -> unit = "ml_cogl_translatex"
external translate : x:int -> y:int -> z:int -> unit = "ml_cogl_translate"
external rotatex: angle:units -> x:int -> y:int -> z:int -> unit
  = "ml_cogl_rotatex"
external rotate: angle:int -> x:int -> y:int -> z:int -> unit = "ml_cogl_rotatex"
external clip_set : x_offset:units -> y_offset:units -> width:units ->
  height:units -> unit = "ml_cogl_clip_set"
external clip_unset : unit -> unit = "ml_cogl_clip_unset"
external enable_depth_test : bool -> unit = "ml_cogl_enable_depth_test"
external alpha_func : func:alpha_func -> ref:units -> unit = "ml_cogl_alpha_func"
external fog_set : color:Clutter.Color.t -> density:units ->
  z_near:units -> z_far:units -> unit = "ml_cogl_fog_set"


  (*

    many cogl tests don't display properly
    
    Machine: OSX 10.4; Intel; ATI Radeon X1600

I've starting playing with the COGL API with the intention of making it part of the OCAML bindings.  My starting point was to try some of the cogl test programs.

cogl-test-primitives.c --> The hard loop in the SPIN() macro causes a total freeze-up and nothing is displayed.  I experimented with various combinations of calling the clutter mainloop or the glib main loop and/or single iterations.  Most of these work OK, but the display is *not* updated unless I drag the window around in order to force a redraw.  i.e. the timer appears to be going and calling the different paint functions, but the display is not updated unless I trigger it with a resize or other type of dirty event.
  *)