--- /dev/null
+(* $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
projects / helm.git / blobdiff