summaryrefslogtreecommitdiff
path: root/src/cairo_gtkcairo.ml
blob: 7801411a1787265f92ac8de8555ad82a41bec55f (plain)
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
(**************************************************************************)
(*  cairo-ocaml -- Objective Caml bindings for Cairo                      *)
(*  Copyright © 2004-2005 Olivier Andrieu                                 *)
(*                                                                        *)
(*  This code is free software and is licensed under the terms of the     *)
(*  GNU Lesser General Public License version 2.1 (the "LGPL").           *)
(**************************************************************************)

type gtkcairo = [Gtk.widget | `gtkcairo]

external gtkcairo_init : unit -> unit = "ml_cairo_gtkcairo_init"
let init = gtkcairo_init ()

external get_cairo : [>`gtkcairo] Gtk.obj -> Cairo.t = "ml_cairo_gtkcairo_get_cairo"

let paint_sig = {
  GtkSignal.name       = "paint" ;
  GtkSignal.classe     = `gtkcairo ;
  GtkSignal.marshaller = 
  let m = GtkSignal.marshal1 Gobject.Data.pointer "GtkCairo::paint" in
  fun cb ->
    m (function 
      | None -> raise Gpointer.Null 
      | Some cairo -> cb (Obj.magic cairo : Cairo.t)) }

class cairo_signals obj = 
  object (self)
    inherit GObj.widget_signals_impl obj
    method paint = self#connect paint_sig
  end

class cairo obj = 
  object
    inherit GObj.widget (obj : [> gtkcairo] Gtk.obj)

    method connect = new cairo_signals obj
    method event = new GObj.event_ops obj
    method cairo = get_cairo obj
    method queue_draw =
      GtkBase.Widget.queue_draw obj
  end

let cairo =
  GtkBase.Widget.size_params []
    ~cont:(fun pl ?packing ?show () ->
      GObj.pack_return 
	(new cairo (GtkObject.make "GtkCairo" pl))
	~packing ~show)