[closure-cvs] CVS update: closure/src/renderer/clim-device.lisp closure/src/renderer/renderer2.lisp closure/src/renderer/x11.lisp

[Christophe Rhodes]

Update of /project/closure/cvsroot/closure/src/renderer
In directory common-lisp.net:/tmp/cvs-serv16629/src/renderer

Modified Files:
	clim-device.lisp renderer2.lisp x11.lisp 
Log Message:
Make images work, more or less.

* restore horrible grecording hack for (medium-)draw-ro*

* make direct drawing of images to x11 work with my X server (32bpp even 
for 24-depth images)

Obviously this should turn into proper clim support for images, at which 
point this horribleness can go away.  However, this now basically works 
for me, modulo compiler consistency strangeness at startup.

Date: Wed Jul 13 15:44:56 2005
Author: crhodes

Index: closure/src/renderer/clim-device.lisp
diff -u closure/src/renderer/clim-device.lisp:1.11 closure/src/renderer/clim-device.lisp:1.12
--- closure/src/renderer/clim-device.lisp:1.11	Sun Jul 10 13:18:35 2005
+++ closure/src/renderer/clim-device.lisp	Wed Jul 13 15:44:55 2005
@@ -446,12 +446,17 @@
                    :actual-width  (or width (r2::aimage-width aim))
                    :actual-height (or height (r2::aimage-height aim)))))
 
-#+NIL
-(climi::def-grecording draw-ro (() ro x y)
-        (values x
-                (- y (nth-value 1 (r2::ro/size ro)))
-                (+ x (nth-value 0 (r2::ro/size ro)))
-                (+ y 0)))
+(climi::def-grecording draw-ro (() ro x y) ()
+  (values x
+	  (- y (nth-value 1 (r2::ro/size ro)))
+	  (+ x (nth-value 0 (r2::ro/size ro)))
+	  (+ y 0)))
+(climi::def-graphic-op draw-ro (ro x y))
+
+(defun draw-ro* (sheet ro x y &rest args)
+  (climi::with-medium-options (sheet args)
+    (medium-draw-ro* medium ro x y)))
+
 
 (defmethod medium-draw-ro* ((medium clim:medium) (self ro/img) x y)
   (progn ;; ignore-errors                        ;xxx


Index: closure/src/renderer/renderer2.lisp
diff -u closure/src/renderer/renderer2.lisp:1.9 closure/src/renderer/renderer2.lisp:1.10
--- closure/src/renderer/renderer2.lisp:1.9	Mon Jul 11 17:57:56 2005
+++ closure/src/renderer/renderer2.lisp	Wed Jul 13 15:44:55 2005
@@ -4,7 +4,7 @@
 ;;;   Created: somewhen late 2002
 ;;;    Author: Gilbert Baumann <gilbert at base-engineering.com>
 ;;;   License: MIT style (see below)
-;;;       $Id: renderer2.lisp,v 1.9 2005/07/11 15:57:56 crhodes Exp $
+;;;       $Id: renderer2.lisp,v 1.10 2005/07/13 13:44:55 crhodes Exp $
 ;;; ---------------------------------------------------------------------------
 ;;;  (c) copyright 1997-2003 by Gilbert Baumann
 
@@ -538,7 +538,7 @@
                            (replaced-object-chunk
                             (let ((ro (replaced-object-chunk-object chunk)))
                               (when (eql pass 1)
-                                (closure/clim-device::medium-draw-ro*
+                                (closure/clim-device::draw-ro*
                                  clim-user::*pane*
                                  ro x (+ dy y)))
                               (incf x (chunk-width chunk))) )))))
@@ -4968,6 +4968,18 @@
 
 
 ;; $Log: renderer2.lisp,v $
+;; Revision 1.10  2005/07/13 13:44:55  crhodes
+;; Make images work, more or less.
+;;
+;; * restore horrible grecording hack for (medium-)draw-ro*
+;;
+;; * make direct drawing of images to x11 work with my X server (32bpp even
+;; for 24-depth images)
+;;
+;; Obviously this should turn into proper clim support for images, at which
+;; point this horribleness can go away.  However, this now basically works
+;; for me, modulo compiler consistency strangeness at startup.
+;;
 ;; Revision 1.9  2005/07/11 15:57:56  crhodes
 ;; Complete the renaming *MEDIUM* -> *PANE*.
 ;;


Index: closure/src/renderer/x11.lisp
diff -u closure/src/renderer/x11.lisp:1.7 closure/src/renderer/x11.lisp:1.8
--- closure/src/renderer/x11.lisp:1.7	Sun Jul 10 12:57:23 2005
+++ closure/src/renderer/x11.lisp	Wed Jul 13 15:44:56 2005
@@ -486,10 +486,16 @@
   (let* ((width (imagelib:aimage-width aimage))
          (height (imagelib:aimage-height aimage))
          (idata (imagelib:aimage-data aimage))
-         (xdata (make-array (list height width) :element-type `(unsigned-byte ,depth)))
+	 ;; FIXME: this (and the :BITS-PER-PIXEL, below) is a hack on
+	 ;; top of a hack.  At some point in the past, XFree86 and/or
+	 ;; X.org decided that they would no longer support pixmaps
+	 ;; with 24 bpp, which seems to be what most AIMAGEs want to
+	 ;; be.  For now, force everything to a 32-bit pixmap.
+         (xdata (make-array (list height width) :element-type '(unsigned-byte 32)))
          (ximage (xlib:create-image :width  width
                                     :height height
                                     :depth  depth
+				    :bits-per-pixel 32
                                     :data   xdata)))
     (declare (type (simple-array (unsigned-byte 32) (* *)) idata)
              #+NIL(type (simple-array (unsigned-byte 8) (* *)) xdata)