X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=cairo%2Fcairo.lisp;h=01bfaf3a69127654391f5aa742bc6ab74fb226e6;hb=HEAD;hp=4cd1928aae3fdddf64217cd605e4939edd5ad39f;hpb=50c841678bb9b914a4f0ef628b66d50b4e8b9fed;p=cl-gtk2.git

diff --git a/cairo/cairo.lisp b/cairo/cairo.lisp
index 4cd1928..01bfaf3 100644
--- a/cairo/cairo.lisp
+++ b/cairo/cairo.lisp
@@ -4,9 +4,9 @@
 
 (defclass gdk-context (cl-cairo2:context)
   ())
-                          
+
 (defun create-gdk-context (gdk-drawable)
-  "creates an context to draw on a GTK widget, more precisely on the
+  "Creates a context to draw on a GTK widget, more precisely on the
 associated gdk-window.  This should only be called from within the
 expose event.  In cells-gtk, use (gtk-adds-widget-window gtk-pointer)
 to obtain the gdk-window. 'gtk-pointer' is the pointer parameter
@@ -61,4 +61,33 @@ to the expose event handler."
   (drawable (g-object drawable)))
 
 (defun gdk-cairo-reset-clip (drawable &optional (context cl-cairo2:*context*))
-  (gdk_cairo_reset_clip (slot-value context 'cl-cairo2:pointer) drawable))
\ No newline at end of file
+  (gdk_cairo_reset_clip (slot-value context 'cl-cairo2:pointer) drawable))
+
+;; This looks nearly as bad as it actually is.  gdk_pixbuf only supports
+;; 32-bit pixels / 8 bits per channel, with RGB bytes in _reverse order_
+;; from cairo.  Needs big-endian testing.
+(defun gdk-pixbuf-from-cairo-image (image)
+  (let ((width (cairo:image-surface-get-width image))
+        (height (cairo:image-surface-get-height image))
+        (src (cairo:image-surface-get-data image :pointer-only t))
+        (src-stride (cairo:image-surface-get-stride image))
+        (format (cairo:image-surface-get-format image)))
+    (unless (or (eq format :argb32) (eq format :rgb24))
+      (error "Unsupported format: ~A~%" format))
+    (let* ((pixbuf (gdk::gdk-pixbuf-new :rgb (eq format :argb32) 8
+                                        width height))
+           (dest-stride (gdk:pixbuf-rowstride pixbuf))
+           (dest (gdk:pixbuf-pixels pixbuf)))
+      (flet ((offset (x c y s) (+ (* x 4) c (* y s))))
+        (dotimes (y height)
+          (dotimes (x width)
+            (setf (mem-ref dest :uint8 (offset x 0 y dest-stride))
+                  (mem-ref src :uint8 (offset x 2 y src-stride)))
+            (setf (mem-ref dest :uint8 (offset x 1 y dest-stride))
+                  (mem-ref src :uint8 (offset x 1 y src-stride)))
+            (setf (mem-ref dest :uint8 (offset x 2 y dest-stride))
+                  (mem-ref src :uint8 (offset x 0 y src-stride)))
+            (setf (mem-ref dest :uint8 (offset x 3 y dest-stride))
+                  (mem-ref src :uint8 (offset x 3 y src-stride))))))
+      pixbuf)))
+