/usr/lib/ocaml/lablgtk2/gnomeCanvas.ml is in liblablgtk2-gnome-ocaml-dev 2.18.3+dfsg-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 | (**************************************************************************)
(* Lablgtk *)
(* *)
(* This program is free software; you can redistribute it *)
(* and/or modify it under the terms of the GNU Library General *)
(* Public License as published by the Free Software Foundation *)
(* version 2, with the exception described in file COPYING which *)
(* comes with the library. *)
(* *)
(* This program is distributed in the hope that it will be useful, *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *)
(* GNU Library General Public License for more details. *)
(* *)
(* You should have received a copy of the GNU Library General *)
(* Public License along with this program; if not, write to the *)
(* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *)
(* Boston, MA 02111-1307 USA *)
(* *)
(* *)
(**************************************************************************)
(* $Id$ *)
type canvas = [Gtk.layout|`canvas]
type item = [`gtk|`canvasitem]
type group = [item|`canvasgroup]
type clipgroup = [group|`canvasclipgroup]
type shape = [item|`canvasshape]
type r_e = [shape|`canvasre]
type rect = [r_e|`canvasrectangle]
type ellipse = [r_e|`canvasellipse]
type bpath = [shape|`canvasbpath]
type polygon = [shape|`canvaspolygon]
type text = [item|`canvastext]
type line = [item|`canvasline]
type pixbuf = [item|`canvaspixbuf]
type widget = [item|`canvaswidget]
type rich_text = [item|`canvasrichtext]
type path_def
(* GnomeCanvas *)
module Canvas =
struct
external new_canvas : unit -> canvas Gobject.obj = "ml_gnome_canvas_new"
external new_canvas_aa : unit -> canvas Gobject.obj = "ml_gnome_canvas_new_aa"
external root : [> canvas] Gobject.obj -> group Gobject.obj = "ml_gnome_canvas_root"
external set_scroll_region : [> canvas] Gobject.obj -> x1:float -> y1:float -> x2:float -> y2:float -> unit = "ml_gnome_canvas_set_scroll_region"
external get_scroll_region : [> canvas] Gobject.obj -> float array = "ml_gnome_canvas_get_scroll_region"
external set_center_scroll_region : [> canvas] Gobject.obj -> bool -> unit = "ml_gnome_canvas_set_center_scroll_region"
external get_center_scroll_region : [> canvas] Gobject.obj -> bool = "ml_gnome_canvas_get_center_scroll_region"
external set_pixels_per_unit : [> canvas] Gobject.obj -> float -> unit = "ml_gnome_canvas_set_pixels_per_unit"
external scroll_to : [> canvas] Gobject.obj -> x:int -> y:int -> unit = "ml_gnome_canvas_scroll_to"
external get_scroll_offsets : [> canvas] Gobject.obj -> int * int = "ml_gnome_canvas_get_scroll_offsets"
external update_now : [> canvas] Gobject.obj -> unit = "ml_gnome_canvas_update_now"
external get_item_at : [> canvas] Gobject.obj -> x:float -> y:float -> item Gobject.obj = "ml_gnome_canvas_get_item_at"
external w2c_affine : [> canvas] Gobject.obj -> float array = "ml_gnome_canvas_w2c_affine"
external w2c : [> canvas] Gobject.obj -> wx:float -> wy:float -> int * int = "ml_gnome_canvas_w2c"
external w2c_d : [> canvas] Gobject.obj -> wx:float -> wy:float -> float * float = "ml_gnome_canvas_w2c_d"
external c2w : [> canvas] Gobject.obj -> cx:float -> cy:float -> float * float = "ml_gnome_canvas_c2w"
external window_to_world : [> canvas] Gobject.obj -> winx:float -> winy:float -> float * float = "ml_gnome_canvas_window_to_world"
external world_to_window : [> canvas] Gobject.obj -> wox:float -> woy:float -> float * float = "ml_gnome_canvas_world_to_window"
end
module PathDef =
struct
type t = Gpointer.boxed
external new_path : ?size:int -> unit -> t = "ml_gnome_canvas_path_def_new"
external duplicate : t -> t = "ml_gnome_canvas_path_def_duplicate"
external concat : t list -> t = "ml_gnome_canvas_path_def_concat"
external reset : t -> unit = "ml_gnome_canvas_path_def_reset"
external moveto : t -> float -> float -> unit = "ml_gnome_canvas_path_def_moveto"
external lineto : t -> float -> float -> unit = "ml_gnome_canvas_path_def_lineto"
external lineto_moving : t -> float -> float -> unit = "ml_gnome_canvas_path_def_lineto_moving"
external curveto : t -> float -> float -> float -> float -> float -> float -> unit = "ml_gnome_canvas_path_def_curveto_bc" "ml_gnome_canvas_path_def_curveto"
external closepath : t -> unit = "ml_gnome_canvas_path_def_closepath"
external closepath_current : t -> unit = "ml_gnome_canvas_path_def_closepath_current"
external length : t -> int = "ml_gnome_canvas_path_def_length"
external is_empty : t -> bool = "ml_gnome_canvas_path_def_is_empty"
external has_currentpoint : t -> bool = "ml_gnome_canvas_path_def_has_currentpoint"
end
type group_p = [`X of float| `Y of float]
type shape_p = [`FILL_COLOR of string| `OUTLINE_COLOR of string
| `NO_FILL_COLOR| `NO_OUTLINE_COLOR
| `FILL_COLOR_RGBA of int32| `FILL_STIPPLE of Gdk.bitmap
| `OUTLINE_COLOR_RGBA of int32| `OUTLINE_STIPPLE of Gdk.bitmap
| `WIDTH_UNITS of float| `WIDTH_PIXELS of int
| `DASH of float * float array
| `CAP_STYLE of Gdk.GC.gdkCapStyle
| `JOIN_STYLE of Gdk.GC.gdkJoinStyle]
type re_p = [shape_p| `X1 of float| `Y1 of float| `X2 of float| `Y2 of float]
type text_p = [`X of float| `Y of float| `TEXT of string| `FONT of string
| `NO_TEXT| `NO_FONT| `NO_FILL_COLOR
| `SIZE of int| `SIZE_POINTS of float| `FILL_COLOR of string
| `FILL_COLOR_RGBA of int32 | `FILL_STIPPLE of Gdk.bitmap
| `CLIP of bool| `CLIP_WIDTH of float| `CLIP_HEIGHT of float
| `X_OFFSET of float| `Y_OFFSET of float
| `JUSTIFICATION of Gtk.Tags.justification
| `ANCHOR of Gtk.Tags.anchor_type| `FAMILY of string
| `MARKUP of string | `RISE of int | `SCALE of float
| `WEIGHT of int]
type line_p = [`ARROW_SHAPE_A of float| `ARROW_SHAPE_B of float| `ARROW_SHAPE_C of float
| `FILL_COLOR of string| `NO_FILL_COLOR
| `WIDTH_UNITS of float| `WIDTH_PIXELS of int
| `POINTS of float array| `FIRST_ARROWHEAD of bool
| `LAST_ARROWHEAD of bool| `SMOOTH of bool
| `FILL_COLOR_RGBA of int32 | `FILL_STIPPLE of Gdk.bitmap
| `CAP_STYLE of Gdk.GC.gdkCapStyle| `JOIN_STYLE of Gdk.GC.gdkJoinStyle
| `LINE_STYLE of Gdk.GC.gdkLineStyle]
type bpath_p = [shape_p| `BPATH of PathDef.t| `NO_BPATH]
type pixbuf_p = [`X of float| `Y of float
| `WIDTH of float| `HEIGHT of float
| `ANCHOR of Gtk.Tags.anchor_type
| `PIXBUF of GdkPixbuf.pixbuf| `NO_PIXBUF]
type polygon_p = [shape_p| `POINTS of float array]
type widget_p = [`X of float| `Y of float
| `WIDTH of float| `HEIGHT of float
| `SIZE_PIXELS of bool
| `ANCHOR of Gtk.Tags.anchor_type
| `WIDGET of GObj.widget| `NO_WIDGET]
type rich_text_p = [`X of float| `Y of float
| `TEXT of string
| `WIDTH of float| `HEIGHT of float
| `EDITABLE of bool | `VISIBLE of bool
| `JUSTIFICATION of Gtk.Tags.justification
| `ANCHOR of Gtk.Tags.anchor_type
| `CURSOR_VISIBLE of bool| `CURSOR_BLINK of bool
| `GROW_HEIGHT of bool
| `LEFT_MARGIN of int| `RIGHT_MARGIN of int]
module Types : sig
type ('a, 'b) t constraint 'a = [> `gtk|`canvasitem]
val group : (group, group_p) t
val rect : ([item|`canvasshape|`canvasRE|`canvasrect], re_p) t
val ellipse : ([item|`canvasshape|`canvasRE|`canvasellipse], re_p) t
val text : ([item|`canvastext], text_p) t
val line : ([item|`canvasline], line_p) t
val bpath : ([item|`canvasshape|`canvasbpath], bpath_p) t
val pixbuf : ([item|`canvaspixbuf], pixbuf_p) t
val polygon : ([item|`canvasshape|`canvaspolygon], polygon_p) t
val widget : ([item|`canvaswidget], widget_p) t
val rich_text : (rich_text, rich_text_p) t
val shape : ([item|`canvasshape], shape_p) t
val rect_ellipse : ([item|`canvasshape|`canvasRE], re_p) t
val points : Gobject.g_type
val is_a : 'a Gobject.obj -> ('b, 'c) t -> bool
val name : ('a, 'b) t -> string
end =
struct
type ('a, 'b) t = Gobject.g_type constraint 'a = [> `gtk|`canvasitem]
external register_types : unit -> Gobject.g_type array
= "ml_gnome_canvas_register_types"
let canvas_types = register_types ()
let group = canvas_types.(4)
let rect = canvas_types.(11)
let ellipse = canvas_types.(3)
let text = canvas_types.(14)
let line = canvas_types.(6)
let bpath = canvas_types.(1)
let pixbuf = canvas_types.(7)
let polygon = canvas_types.(9)
let shape = canvas_types.(13)
let rect_ellipse = canvas_types.(10)
let widget = canvas_types.(2)
let rich_text = canvas_types.(12)
let points = canvas_types.(8)
let is_a obj typ =
Gobject.Type.is_a (Gobject.get_type obj) typ
let name = Gobject.Type.name
end
(* GnomeCanvasItem *)
type item_event =
[ `BUTTON_PRESS | `TWO_BUTTON_PRESS | `THREE_BUTTON_PRESS | `BUTTON_RELEASE
| `MOTION_NOTIFY | `KEY_PRESS | `KEY_RELEASE | `ENTER_NOTIFY | `LEAVE_NOTIFY
| `FOCUS_CHANGE ] Gdk.event
module Item =
struct
external new_item : [> group] Gobject.obj -> ('a, 'b) Types.t -> 'a Gobject.obj = "ml_gnome_canvas_item_new"
external parent : [> item] Gobject.obj -> group Gobject.obj = "ml_gnome_canvas_item_parent"
external canvas : [> item] Gobject.obj -> canvas Gobject.obj = "ml_gnome_canvas_item_canvas"
external xform : [> item] Gobject.obj -> [`IDENTITY|`TRANSL of float array|`AFFINE of float array] = "ml_gnome_canvas_item_xform"
external affine_relative : [> item] Gobject.obj -> float array -> unit = "ml_gnome_canvas_item_affine_relative"
external affine_absolute : [> item] Gobject.obj -> float array -> unit = "ml_gnome_canvas_item_affine_absolute"
external set : [> item] Gobject.obj -> unit = "ml_gnome_canvas_item_set"
(* Must call [set] after using [Gobject.Property.set] *)
external move : [> item] Gobject.obj -> x:float -> y:float -> unit = "ml_gnome_canvas_item_move"
external raise : [> item] Gobject.obj -> int -> unit = "ml_gnome_canvas_item_raise"
external lower : [> item] Gobject.obj -> int -> unit = "ml_gnome_canvas_item_lower"
external raise_to_top : [> item] Gobject.obj -> unit = "ml_gnome_canvas_item_raise_to_top"
external lower_to_bottom : [> item] Gobject.obj -> unit = "ml_gnome_canvas_item_lower_to_bottom"
external show : [> item] Gobject.obj -> unit = "ml_gnome_canvas_item_show"
external hide : [> item] Gobject.obj -> unit = "ml_gnome_canvas_item_hide"
external grab : [> item] Gobject.obj -> Gdk.Tags.event_mask list -> Gdk.cursor -> int32 -> unit = "ml_gnome_canvas_item_grab"
external ungrab : [> item] Gobject.obj -> int32 -> unit = "ml_gnome_canvas_item_ungrab"
external w2i : [> item] Gobject.obj -> x:float -> y:float -> float * float = "ml_gnome_canvas_item_w2i"
external i2w : [> item] Gobject.obj -> x:float -> y:float -> float * float = "ml_gnome_canvas_item_i2w"
external i2w_affine : [> item] Gobject.obj -> float array = "ml_gnome_canvas_item_i2w_affine"
external i2c_affine : [> item] Gobject.obj -> float array = "ml_gnome_canvas_item_i2c_affine"
external reparent : [> item] Gobject.obj -> group Gobject.obj -> unit = "ml_gnome_canvas_item_reparent"
external grab_focus : [> item] Gobject.obj -> unit = "ml_gnome_canvas_item_grab_focus"
external get_bounds : [> item] Gobject.obj -> float array = "ml_gnome_canvas_item_get_bounds"
module Signals = struct
let marshal = GtkBase.Widget.Signals.Event.marshal
let event : ([> `canvasitem], item_event -> bool) GtkSignal.t =
{ GtkSignal.name = "event";
GtkSignal.classe = `canvasitem;
GtkSignal.marshaller = marshal; }
end
end
(* GnomeCanvasGroup *)
module Group =
struct
external get_items : [> group] Gobject.obj -> item Gobject.obj list = "ml_gnome_canvas_group_get_items"
end
module Text =
struct
let text_width = { Gobject.name = "text-width"; Gobject.conv = Gobject.Data.double }
let text_height = { Gobject.name = "text-height"; Gobject.conv = Gobject.Data.double }
end
(* GnomeCanvasRichText *)
module RichText =
struct
external cut_clipboard : [> rich_text] Gobject.obj -> unit = "ml_gnome_canvas_rich_text_cut_clipboard"
external copy_clipboard : [> rich_text] Gobject.obj -> unit = "ml_gnome_canvas_rich_text_copy_clipboard"
external paste_clipboard : [> rich_text] Gobject.obj -> unit = "ml_gnome_canvas_rich_text_paste_clipboard"
external get_buffer : [> rich_text] Gobject.obj -> Gtk.text_buffer = "ml_gnome_canvas_rich_text_get_buffer"
end
(* Conversion functions for properties *)
module Conv = struct
external convert_points : float array -> Gpointer.boxed
= "ml_gnome_canvas_convert_points"
external convert_dash : float -> float array -> Gpointer.boxed
= "ml_gnome_canvas_convert_dash"
external get_points : Gpointer.boxed -> float array
= "ml_gnome_canvas_get_points"
external get_dash : Gpointer.boxed -> float * float array
= "ml_gnome_canvas_get_dash"
open Gaux
open Gobject
let points =
{ kind = `OTHER (Type.from_name "GnomeCanvasPoints");
inj = (fun x -> `POINTER (may_map convert_points x));
proj = (fun x -> may_map get_points (Data.pointer.proj x)) }
let art_vpath_dash =
{ kind = `POINTER;
inj = (fun x -> `POINTER (may_map (fun (x,y) -> convert_dash x y) x));
proj = (fun x -> may_map get_dash (Data.pointer.proj x)) }
let path_def =
{ kind = `POINTER; inj = Data.unsafe_pointer_option.inj; proj =
(fun x -> may_map PathDef.duplicate (Data.unsafe_pointer_option.proj x)) }
end
|