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