From 4095a1b99db20d69ae5cc7f24c3cd74da675cd71 Mon Sep 17 00:00:00 2001 From: csr21 <unknown> Date: Sat, 7 Jun 2003 05:09:43 -0400 Subject: [PATCH] Fix the image test: Fix the image test: * don't abuse the "cursor hotspot" fields, which are defined to be CARD16 or NULL, for communicating the position of the (sub)image on the root window; instead, use the image plist (and adjust as necessary if a subimage is copied). * rather than writing in very very dark red (or blue) on black, explicitly ask for white on black. darcs-hash:20030607090943-ed5a3-65828f7e8c98f4dcaa3d9bdcdb23569a90a16f67.gz --- test/image.lisp | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/test/image.lisp b/test/image.lisp index 48e94d0..13e053e 100644 --- a/test/image.lisp +++ b/test/image.lisp @@ -48,8 +48,10 @@ (let* ((screen (display-default-screen display)) (window (screen-root screen)) (gcontext (create-gcontext - :drawable window - :font (open-font display "fixed")))) + :foreground (screen-white-pixel screen) + :background (screen-black-pixel screen) + :drawable window + :font (open-font display "fixed")))) (dotimes (i nimages) (let ((image (image-test-get-image window @@ -92,10 +94,8 @@ (image-z :z-pixmap))) (image (get-image window :x x :y y :width width :height height :format format :result-type result-type))) - ;; XCreatePixmapCursor(3X11) says that x,y for hotspot are - ;; unsigned, so what we're doing here I don't know - ;;(setf (image-x-hot image) (- x)) - ;;(setf (image-y-hot image) (- y)) + (setf (getf (image-plist image) :root-x) x) + (setf (getf (image-plist image) :root-y) y) image)) (defun image-test-subimage-parameters (image random-subimage-p) @@ -120,6 +120,8 @@ ((or image-xy image-z) 'image-x))))) (multiple-value-bind (x y width height) (image-test-subimage-parameters image random-subimage-p) + (incf (getf (image-plist image) :root-x) x) + (incf (getf (image-plist image) :root-y) y) (copy-image image :x x :y y :width width :height height :result-type result-type)))) @@ -127,8 +129,10 @@ (multiple-value-bind (src-x src-y width height) (image-test-subimage-parameters image random-subimage-p) (let* ((border-width 1) - (x (- src-x #+nil (image-x-hot image) border-width)) - (y (- src-y #+nil (image-y-hot image) border-width))) + (root-x (getf (image-plist image) :root-x)) + (root-y (getf (image-plist image) :root-y)) + (x (+ src-x root-x (- border-width))) + (y (+ src-y root-y (- border-width)))) (unless (or (zerop width) (zerop height)) (let ((window (create-window -- GitLab