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))))