1 (in-package #:cl-gtk2-cairo
)
3 (defcfun gdk-cairo-create
:pointer
(drawable (g-object drawable
)))
5 (defclass gdk-context
(cl-cairo2:context
)
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
)))
17 (defmethod cl-cairo2:destroy
((self gdk-context
))
18 (cl-cairo2::cairo_destroy
(slot-value self
'cl-cairo2
:pointer
)))
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
)
30 (cl-cairo2:destroy
,context
))))
32 (defcfun gdk_cairo_set_source_pixbuf
:void
34 (pixbuf (g-object pixbuf
))
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
))
42 (defcfun gdk_cairo_set_source_pixmap
:void
44 (pixmap (g-object pixmap
))
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
))
52 (defcfun gdk_cairo_region
:void
54 (region (g-boxed-foreign region
)))
56 (defun gdk-cairo-region (region &optional
(context cl-cairo2
:*context
*))
57 (gdk_cairo_region (slot-value context
'cl-cairo2
:pointer
) region
))
59 (defcfun gdk_cairo_reset_clip
:void
61 (drawable (g-object drawable
)))
63 (defun gdk-cairo-reset-clip (drawable &optional
(context cl-cairo2
:*context
*))
64 (gdk_cairo_reset_clip (slot-value context
'cl-cairo2
:pointer
) drawable
))