cursor hotspots

There's a bug in the test/image.lisp test, I think.  In the CLX I have
here, running on SBCL, I was getting

* (image-test)
Image=#<IMAGE-Z 696x405x16>

debugger invoked on condition of type TYPE-ERROR:
  The value -10 is not of type (UNSIGNED-BYTE 29).

and similar messages.  After turning on some debugging optimization,
this proved to be caused by these lines

      (when (and (image-x-hot image) (not (index-zerop x)))
	(setf (image-x-hot copy) (index- (image-x-hot image) x)))
      (when (and (image-y-hot image) (not (index-zerop y)))
	(setf (image-y-hot copy) (index- (image-y-hot image) y)))

(image.lisp line 2416, in the COPY-IMAGE function) which didn't like
images that had negative x-hot or y-hot attributes.  XCreateFontCursor(3X11) 
suggests that these are supposed to be unsigned ints, so I think this
is a reasonable objection and the test file should not be passing
negative values in.  Comments?

Index: test/image.lisp
===================================================================
RCS file: /usr/local/src/cvs/clx/test/image.lisp,v
retrieving revision 1.1.1.1
diff -u -r1.1.1.1 image.lisp
--- test/image.lisp     2000/07/02 19:19:45     1.1.1.1
+++ test/image.lisp     2003/02/21 16:42:41
@@ -92,8 +92,10 @@
             (image-z :z-pixmap)))
         (image (get-image window :x x :y y :width width :height height
                           :format format :result-type result-type)))
-    (setf (image-x-hot image) (- x))
-    (setf (image-y-hot image) (- y))
+    ;; 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))
     image))
 
 (defun image-test-subimage-parameters (image random-subimage-p)
@@ -125,8 +127,8 @@
   (multiple-value-bind (src-x src-y width height)
       (image-test-subimage-parameters image random-subimage-p)
     (let* ((border-width 1)
-          (x (- src-x (image-x-hot image) border-width))
-          (y (- src-y (image-y-hot image) border-width)))
+          (x (- src-x #+nil (image-x-hot image) border-width))
+          (y (- src-y #+nil (image-y-hot image) border-width)))
       (unless (or (zerop width) (zerop height))
        (let ((window
                (create-window


With this change, the test opens a borderless window and then sits
busily doing nothing visible until interrupted.  This is apparently
what it's supposed to do.  Fine.


-dan

-- 

   http://www.cliki.net/ - Link farm for free CL-on-Unix resources