(* $Id$ *)

type colormap
type visual
type region
type gc
type 'a drawable
type window = [`window] drawable
type pixmap = [`pixmap] drawable
type bitmap = [`bitmap] drawable
type font
type image
type atom = int
type keysym = int
type 'a event
type drag_context
type cursor
type xid = int32

exception Error of string

module Tags : sig
  type event_type =
    [ `NOTHING|`DELETE|`DESTROY|`EXPOSE|`MOTION_NOTIFY|`BUTTON_PRESS
     |`TWO_BUTTON_PRESS|`THREE_BUTTON_PRESS
     |`BUTTON_RELEASE|`KEY_PRESS
     |`KEY_RELEASE|`ENTER_NOTIFY|`LEAVE_NOTIFY|`FOCUS_CHANGE
     |`CONFIGURE|`MAP|`UNMAP|`PROPERTY_NOTIFY|`SELECTION_CLEAR
     |`SELECTION_REQUEST|`SELECTION_NOTIFY|`PROXIMITY_IN
     |`PROXIMITY_OUT|`DRAG_ENTER|`DRAG_LEAVE|`DRAG_MOTION|`DRAG_STATUS
     |`DROP_START|`DROP_FINISHED|`CLIENT_EVENT|`VISIBILITY_NOTIFY
     |`NO_EXPOSE ]
  type event_mask =
    [ `EXPOSURE
     |`POINTER_MOTION|`POINTER_MOTION_HINT
     |`BUTTON_MOTION|`BUTTON1_MOTION|`BUTTON2_MOTION|`BUTTON3_MOTION
     |`BUTTON_PRESS|`BUTTON_RELEASE
     |`KEY_PRESS|`KEY_RELEASE
     |`ENTER_NOTIFY|`LEAVE_NOTIFY|`FOCUS_CHANGE
     |`STRUCTURE|`PROPERTY_CHANGE|`VISIBILITY_NOTIFY
     |`PROXIMITY_IN|`PROXIMITY_OUT|`SUBSTRUCTURE
     |`ALL_EVENTS ]
  type extension_events = [ `NONE|`ALL|`CURSOR ]
  type visibility_state = [ `UNOBSCURED|`PARTIAL|`FULLY_OBSCURED ]
  type input_source = [ `MOUSE|`PEN|`ERASER|`CURSOR ]
  type notify_type =
    [ `ANCESTOR|`VIRTUAL|`INFERIOR|`NONLINEAR|`NONLINEAR_VIRTUAL|`UNKNOWN ] 
  type crossing_mode = [ `NORMAL|`GRAB|`UNGRAB ]
  type modifier =
    [ `SHIFT|`LOCK|`CONTROL|`MOD1|`MOD2|`MOD3|`MOD4|`MOD5|`BUTTON1
     |`BUTTON2|`BUTTON3|`BUTTON4|`BUTTON5 ]
  type drag_action = [ `DEFAULT|`COPY|`MOVE|`LINK|`PRIVATE|`ASK ]
end

module Convert :
  sig
    val modifier : int -> Tags.modifier list
  end

module Screen :
  sig
    external width : unit -> int = "ml_gdk_screen_width"
    external height : unit -> int = "ml_gdk_screen_height"
  end

module Visual :
  sig
    type visual_type =
      [ `STATIC_GRAY|`GRAYSCALE|`STATIC_COLOR
       |`PSEUDO_COLOR|`TRUE_COLOR|`DIRECT_COLOR ]
    external get_best : ?depth:int -> ?kind:visual_type -> unit -> visual
        = "ml_gdk_visual_get_best"
    external get_type : visual -> visual_type = "ml_GdkVisual_type"
    external depth : visual -> int = "ml_GdkVisual_depth"
    external red_mask : visual -> int = "ml_GdkVisual_red_mask"
    external red_shift : visual -> int = "ml_GdkVisual_red_shift"
    external red_prec : visual -> int = "ml_GdkVisual_red_prec"
    external green_mask : visual -> int = "ml_GdkVisual_green_mask"
    external green_shift : visual -> int = "ml_GdkVisual_green_shift"
    external green_prec : visual -> int = "ml_GdkVisual_green_prec"
    external blue_mask : visual -> int = "ml_GdkVisual_blue_mask"
    external blue_shift : visual -> int = "ml_GdkVisual_blue_shift"
    external blue_prec : visual -> int = "ml_GdkVisual_blue_prec"
  end

module Image :
  sig
    type image_type = [ `FASTEST|`NORMAL|`SHARED ]
    external create_bitmap :
      visual:visual -> data:string -> width:int -> height:int -> image
      = "ml_gdk_image_new_bitmap"
    external create :
      kind:image_type ->
      visual:visual -> width:int -> height:int -> image = "ml_gdk_image_new"
    external get :
      'a drawable -> x:int -> y:int -> width:int -> height:int -> image
      = "ml_gdk_image_get"
    external put_pixel : image -> x:int -> y:int -> pixel:int -> unit
      = "ml_gdk_image_put_pixel"
    external get_pixel : image -> x:int -> y:int -> int
      = "ml_gdk_image_get_pixel"
    external destroy : image -> unit = "ml_gdk_image_destroy"
  end

module Color :
  sig
    external get_system_colormap : unit -> colormap
	= "ml_gdk_colormap_get_system"
    val get_colormap : ?privat:bool -> visual -> colormap

    type t
    type spec = [
      | `BLACK
      | `NAME of string
      | `RGB of int * int * int
      | `WHITE
    ]
    val alloc : colormap:colormap -> spec -> t
    external red : t -> int = "ml_GdkColor_red"
    external blue : t -> int = "ml_GdkColor_blue"
    external green : t -> int = "ml_GdkColor_green"
    external pixel : t -> int = "ml_GdkColor_pixel"
  end

module Rectangle :
  sig
    type t
    external create : x:int -> y:int -> width:int -> height:int -> t
      = "ml_GdkRectangle"
    external x : t -> int = "ml_GdkRectangle_x"
    external y : t -> int = "ml_GdkRectangle_y"
    external width : t -> int = "ml_GdkRectangle_width"
    external height : t -> int = "ml_GdkRectangle_height"
  end

module Window :
  sig
    type background_pixmap = [ `NONE|`PARENT_RELATIVE|`PIXMAP of pixmap ]
    external visual_depth : visual -> int = "ml_gdk_visual_get_depth"
    external get_visual : window -> visual = "ml_gdk_window_get_visual"
    external get_parent : window -> window = "ml_gdk_window_get_parent"
    external get_size : window -> int * int = "ml_gdk_window_get_size"
    external get_position : window -> int * int
      = "ml_gdk_window_get_position"
    external root_parent : unit -> window = "ml_GDK_ROOT_PARENT"
    external clear : window -> unit = "ml_gdk_window_clear"
    external get_xwindow : window -> xid = "ml_GDK_WINDOW_XWINDOW"
    val set_back_pixmap : window -> background_pixmap -> unit
  end

module PointArray :
  sig
    type t = { len: int }
    external create : len:int -> t = "ml_point_array_new"
    val set : t -> pos:int -> x:int -> y:int -> unit
  end

module Region :
  sig
    type gdkFillRule = [ `EVEN_ODD_RULE|`WINDING_RULE ]
    type gdkOverlapType = [ `IN|`OUT|`PART ]
    external create : unit -> region = "ml_gdk_region_new"
    external destroy : region -> unit = "ml_gdk_region_destroy"
    val polygon : (int * int) list -> gdkFillRule -> region 
    external intersect : region -> region -> region
      = "ml_gdk_regions_intersect"
    external union : region -> region -> region 
      = "ml_gdk_regions_union"
    external subtract : region -> region -> region 
      = "ml_gdk_regions_subtract"
    external xor : region -> region -> region 
      = "ml_gdk_regions_xor"
    external union_with_rect : region -> Rectangle.t -> region
      = "ml_gdk_region_union_with_rect"
    external offset : region -> x:int -> y:int -> unit = "ml_gdk_region_offset"
    external shrink : region -> x:int -> y:int -> unit = "ml_gdk_region_shrink"
    external empty : region -> bool = "ml_gdk_region_empty"
    external equal : region -> region -> bool = "ml_gdk_region_equal"
    external point_in : region -> x:int -> y:int -> bool 
      = "ml_gdk_region_point_in"
    external rect_in : region -> Rectangle.t -> gdkOverlapType
      = "ml_gdk_region_rect_in"
    external get_clipbox : region -> Rectangle.t -> unit
      = "ml_gdk_region_get_clipbox"
  end

module GC :
  sig
    type gdkFunction = [ `COPY|`INVERT|`XOR ]
    type gdkFill = [ `SOLID|`TILED|`STIPPLED|`OPAQUE_STIPPLED ]
    type gdkSubwindowMode = [ `CLIP_BY_CHILDREN|`INCLUDE_INFERIORS ]
    type gdkLineStyle = [ `SOLID|`ON_OFF_DASH|`DOUBLE_DASH ]
    type gdkCapStyle = [ `NOT_LAST|`BUTT|`ROUND|`PROJECTING ]
    type gdkJoinStyle = [ `MITER|`ROUND|`BEVEL ]
    external create : 'a drawable -> gc = "ml_gdk_gc_new"
    external set_foreground : gc -> Color.t -> unit
      = "ml_gdk_gc_set_foreground"
    external set_background : gc -> Color.t -> unit
      = "ml_gdk_gc_set_background"
    external set_font : gc -> font -> unit = "ml_gdk_gc_set_font"
    external set_function : gc -> gdkFunction -> unit
      = "ml_gdk_gc_set_function"
    external set_fill : gc -> gdkFill -> unit = "ml_gdk_gc_set_fill"
    external set_tile : gc -> pixmap -> unit = "ml_gdk_gc_set_tile"
    external set_stipple : gc -> pixmap -> unit = "ml_gdk_gc_set_stipple"
    external set_ts_origin : gc -> x:int -> y:int -> unit
      = "ml_gdk_gc_set_ts_origin"
    external set_clip_origin : gc -> x:int -> y:int -> unit
      = "ml_gdk_gc_set_clip_origin"
    external set_clip_mask : gc -> bitmap -> unit = "ml_gdk_gc_set_clip_mask"
    external set_clip_rectangle : gc -> Rectangle.t -> unit
      = "ml_gdk_gc_set_clip_rectangle"
    external set_clip_region : gc -> region -> unit
	= "ml_gdk_gc_set_clip_region"
    external set_subwindow : gc -> gdkSubwindowMode -> unit
      = "ml_gdk_gc_set_subwindow"
    external set_exposures : gc -> bool -> unit = "ml_gdk_gc_set_exposures"
    external set_line_attributes :
      gc ->
      width:int ->
      style:gdkLineStyle -> cap:gdkCapStyle -> join:gdkJoinStyle -> unit
      = "ml_gdk_gc_set_line_attributes"
    external copy : dst:gc -> gc -> unit = "ml_gdk_gc_copy"
    type values = {
        foreground : Color.t;
        background : Color.t;
        font : font option;
        fonction : gdkFunction;
        fill : gdkFill;
        tile : pixmap option;
        stipple : pixmap option;
        clip_mask : bitmap option;
        subwindow_mode : gdkSubwindowMode;
        ts_x_origin : int;
        ts_y_origin : int;
        clip_x_origin : int;
        clip_y_origin : int;
        graphics_exposures : bool;
        line_width : int;
        line_style : gdkLineStyle;
        cap_style : gdkCapStyle;
        join_style : gdkJoinStyle;
      }
    external get_values : gc -> values = "ml_gdk_gc_get_values"
  end

module Pixmap :
  sig
    external create :
      window -> width:int -> height:int -> depth:int -> pixmap
      = "ml_gdk_pixmap_new"
    external create_from_data :
      window ->
      string ->
      width:int ->
      height:int -> depth:int -> fg:Color.t -> bg:Color.t -> pixmap
      = "ml_gdk_pixmap_create_from_data_bc" "ml_gk_pixmap_create_from_data"
    external create_from_xpm :
      window ->
      ?colormap:colormap ->
      ?transparent:Color.t -> file:string -> pixmap * bitmap
      = "ml_gdk_pixmap_colormap_create_from_xpm"
    external create_from_xpm_d :
      window ->
      ?colormap:colormap ->
      ?transparent:Color.t -> data:string array -> pixmap * bitmap
      = "ml_gdk_pixmap_colormap_create_from_xpm_d"
  end

module Bitmap :
  sig
    val create : window -> width:int -> height:int -> bitmap
    external create_from_data :
      window -> string -> width:int -> height:int -> bitmap
      = "ml_gdk_bitmap_create_from_data"
  end

module Font :
  sig
    external load : string -> font = "ml_gdk_font_load"
    external load_fontset : string -> font = "ml_gdk_fontset_load"
    external string_width : font -> string -> int = "ml_gdk_string_width"
    external char_width : font -> char -> int = "ml_gdk_char_width"
    external string_height : font -> string -> int = "ml_gdk_string_height"
    external char_height : font -> char -> int = "ml_gdk_char_height"
    external string_measure : font -> string -> int = "ml_gdk_string_measure"
    external char_measure : font -> char -> int = "ml_gdk_char_measure"
    external get_type : font -> [`FONT | `FONTSET] = "ml_GdkFont_type"
    external ascent : font -> int = "ml_GdkFont_ascent"
    external descent : font -> int = "ml_GdkFont_descent"
  end

module Draw :
  sig
    external point : 'a drawable -> gc -> x:int -> y:int -> unit
      = "ml_gdk_draw_point"
    external line :
      'a drawable -> gc -> x:int -> y:int -> x:int -> y:int -> unit
      = "ml_gdk_draw_line_bc" "ml_gdk_draw_line"
    val rectangle :
      'a drawable -> gc ->
      x:int -> y:int -> width:int -> height:int -> ?filled:bool -> unit -> unit
    val arc :
      'a drawable -> gc ->
      x:int -> y:int -> width:int -> height:int ->
      ?filled:bool -> ?start:float -> ?angle:float -> unit -> unit
    val polygon :
      'a drawable -> gc -> ?filled:bool ->(int * int) list -> unit
    external string :
      'a drawable ->
      font:font -> gc -> x:int -> y:int -> string:string -> unit
      = "ml_gdk_draw_string_bc" "ml_gdk_draw_string"
    external image :
      'a drawable ->
      gc ->
      image:image ->
      xsrc:int ->
      ysrc:int -> xdest:int -> ydest:int -> width:int -> height:int -> unit
      = "ml_gdk_draw_image_bc" "ml_gdk_draw_image"
  end

module Rgb :
  sig
    external init : unit -> unit = "ml_gdk_rgb_init"
    external get_visual : unit -> visual = "ml_gdk_rgb_get_visual"
    external get_cmap : unit -> colormap = "ml_gdk_rgb_get_cmap"
  end

module DnD :
  sig
    external drag_status :
      drag_context -> Tags.drag_action list -> time:int -> unit
      = "ml_gdk_drag_status"
    external drag_context_suggested_action : drag_context -> Tags.drag_action
      = "ml_GdkDragContext_suggested_action"
    external drag_context_targets : drag_context -> atom list
      = "ml_GdkDragContext_targets"
  end

module Truecolor :
  sig
    val color_creator : visual -> (red: int -> green: int -> blue: int -> int)
	(* [color_creator visual] creates a function to calculate 
	   the pixel color id for given red, green and blue component 
	   value ([0..65535]) at the client side. [visual] must have 
           `TRUE_COLOR or `DIRECT_COLOR type. This function improves
           the speed of the color query of true color visual greatly. *)
	(* WARN: this approach is not theoretically correct for true color
	   visual, because we need gamma correction. *)

    val color_parser : visual -> int -> int * int * int
  end

module X :
  (* X related functions *)
  sig
    val flush : unit -> unit (* also in GtkMain *)
    val beep : unit -> unit
  end

module Cursor : sig
  type cursor_type = [
    | `X_CURSOR
    | `ARROW
    | `BASED_ARROW_DOWN
    | `BASED_ARROW_UP
    | `BOAT
    | `BOGOSITY
    | `BOTTOM_LEFT_CORNER
    | `BOTTOM_RIGHT_CORNER
    | `BOTTOM_SIDE
    | `BOTTOM_TEE
    | `BOX_SPIRAL
    | `CENTER_PTR
    | `CIRCLE
    | `CLOCK
    | `COFFEE_MUG
    | `CROSS
    | `CROSS_REVERSE
    | `CROSSHAIR
    | `DIAMOND_CROSS
    | `DOT
    | `DOTBOX
    | `DOUBLE_ARROW
    | `DRAFT_LARGE
    | `DRAFT_SMALL
    | `DRAPED_BOX
    | `EXCHANGE
    | `FLEUR
    | `GOBBLER
    | `GUMBY
    | `HAND1
    | `HAND2
    | `HEART
    | `ICON
    | `IRON_CROSS
    | `LEFT_PTR
    | `LEFT_SIDE
    | `LEFT_TEE
    | `LEFTBUTTON
    | `LL_ANGLE
    | `LR_ANGLE
    | `MAN
    | `MIDDLEBUTTON
    | `MOUSE
    | `PENCIL
    | `PIRATE
    | `PLUS
    | `QUESTION_ARROW
    | `RIGHT_PTR
    | `RIGHT_SIDE
    | `RIGHT_TEE
    | `RIGHTBUTTON
    | `RTL_LOGO
    | `SAILBOAT
    | `SB_DOWN_ARROW
    | `SB_H_DOUBLE_ARROW
    | `SB_LEFT_ARROW
    | `SB_RIGHT_ARROW
    | `SB_UP_ARROW
    | `SB_V_DOUBLE_ARROW
    | `SHUTTLE
    | `SIZING
    | `SPIDER
    | `SPRAYCAN
    | `STAR
    | `TARGET
    | `TCROSS
    | `TOP_LEFT_ARROW
    | `TOP_LEFT_CORNER
    | `TOP_RIGHT_CORNER
    | `TOP_SIDE
    | `TOP_TEE
    | `TREK
    | `UL_ANGLE
    | `UMBRELLA
    | `UR_ANGLE
    | `WATCH
    | `XTERM
  ]
  external create : cursor_type -> cursor = "ml_gdk_cursor_new"
  external create_from_pixmap :
    pixmap -> mask:bitmap ->
    fg:Color.t -> bg:Color.t -> x:int -> y:int -> cursor
    = "ml_gdk_cursor_new_from_pixmap_bc" "ml_gdk_cursor_new_from_pixmap"
  external destroy : cursor -> unit = "ml_gdk_cursor_destroy"
end