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