4cd1928aae3fdddf64217cd605e4939edd5ad39f
[cl-gtk2.git] / cairo / cairo.lisp
1 (in-package #:cl-gtk2-cairo)
2
3 (defcfun gdk-cairo-create :pointer (drawable (g-object drawable)))
4
5 (defclass gdk-context (cl-cairo2:context)
6   ())
7                           
8 (defun create-gdk-context (gdk-drawable)
9   "creates an context to draw on a GTK widget, more precisely on the
10 associated gdk-window.  This should only be called from within the
11 expose event.  In cells-gtk, use (gtk-adds-widget-window gtk-pointer)
12 to obtain the gdk-window. 'gtk-pointer' is the pointer parameter
13 passed to the expose event handler."
14   (make-instance 'gdk-context
15                  :pointer (gdk-cairo-create gdk-drawable)))
16
17 (defmethod cl-cairo2:destroy ((self gdk-context))
18   (cl-cairo2::cairo_destroy (slot-value self 'cl-cairo2:pointer)))
19
20 (defmacro with-gdk-context ((context gdk-drawable) &body body)
21   "Executes body while context is bound to a valid cairo context for
22 gdk-window.  This should only be called from within an expose event
23 handler.  In cells-gtk, use (gtk-adds-widget-window gtk-pointer) to
24 obtain the gdk-window. 'gtk-pointer' is the pointer parameter passed
25 to the expose event handler."
26   (cl-utilities:with-gensyms (context-pointer)
27     `(let ((,context (create-gdk-context ,gdk-drawable)))
28        (cl-cairo2::with-context-pointer (,context ,context-pointer)
29          ,@body)
30        (cl-cairo2:destroy ,context))))
31
32 (defcfun gdk_cairo_set_source_pixbuf :void
33   (cr :pointer)
34   (pixbuf (g-object pixbuf))
35   (pixbuf-x :int)
36   (pixbuf-y :int))
37
38 (defun gdk-cairo-set-source-pixbuf (pixbuf pixbuf-x pixbuf-y &optional (context cl-cairo2:*context*))
39   (gdk_cairo_set_source_pixbuf (slot-value context 'cl-cairo2:pointer)
40                                pixbuf pixbuf-x pixbuf-y))
41
42 (defcfun gdk_cairo_set_source_pixmap :void
43   (cr :pointer)
44   (pixmap (g-object pixmap))
45   (pixmap-x :double)
46   (pixmap-y :double))
47
48 (defun gdk-cairo-set-source-pixmap (pixmap pixmap-x pixmap-y &optional (context cl-cairo2:*context*))
49   (gdk_cairo_set_source_pixmap (slot-value context 'cl-cairo2:pointer)
50                                pixmap pixmap-x pixmap-y))
51
52 (defcfun gdk_cairo_region :void
53   (cr :pointer)
54   (region (g-boxed-foreign region)))
55
56 (defun gdk-cairo-region (region &optional (context cl-cairo2:*context*))
57   (gdk_cairo_region (slot-value context 'cl-cairo2:pointer) region))
58
59 (defcfun gdk_cairo_reset_clip :void
60   (cr :pointer)
61   (drawable (g-object drawable)))
62
63 (defun gdk-cairo-reset-clip (drawable &optional (context cl-cairo2:*context*))
64   (gdk_cairo_reset_clip (slot-value context 'cl-cairo2:pointer) drawable))