]> birchwood-abbey.net Git - mit-scheme.git/commitdiff
x11: Fix x-bytes-into-image.
authorTaylor R Campbell <campbell+mit-scheme@mumble.net>
Mon, 18 Jan 2021 04:14:52 +0000 (04:14 +0000)
committerTaylor R Campbell <campbell+mit-scheme@mumble.net>
Mon, 18 Jan 2021 23:36:54 +0000 (23:36 +0000)
Restore the old behaviour on vectors (not bytevectors) of integers,
which apparently 6001 uses.

(cherry picked from commit f7d8d5c43c5c079a4cc360c8f2970b717d4ffe05)

src/x11/x11-graphics.scm
src/x11/x11.cdecl
src/x11/x11graph.c

index 13830ac3ba2ca428ec30e626f78ef6be2ac63962..074276687ba0c4ca00abb064000bb951254d3984 100644 (file)
@@ -197,8 +197,18 @@ USA.
   ;; have the same number of pixels as image.  These pixels are written onto
   ;; image by repeated calls to XPutPixel.  This procedure is equivalent to
   ;; calling x-set-pixel-in-image for each pixel in vector.
-  (guarantee bytevector? vector 'x-bytes-into-image)
-  (C-call "x_bytes_into_image" vector image))
+  (cond ((bytevector? vector)
+        (C-call "x_bytes_into_image" vector image))
+       ((vector? vector)
+        (let ((w (C-call "x_image_width" image))
+              (h (C-call "x_image_height" image)))
+          (if (not (= (* w h) (vector-length vector)))
+              (error:bad-range-argument vector 'X-BYTES-INTO-IMAGE))
+          (do ((y 0 (+ y 1)) (i 0 (+ i w))) ((>= y h))
+            (do ((x 0 (+ x 1)) (i i (+ i 1))) ((>= x w))
+              (x-set-pixel-in-image image x y (vector-ref vector i))))))
+       (else
+        (error:wrong-type-argument vector 'X-BYTES-INTO-IMAGE))))
 
 (define (x-get-pixel-from-image image x y)
   (let ((pixel (C-call "x_get_pixel_from_image" image x y)))
index ee8083c2b5052ffa64c5d4873d5b6c1d9b67bb5a..f23a7e48f678dc04021796e183bca6cd1d6e7a1a 100644 (file)
@@ -817,6 +817,9 @@ USA.
        (xw (* (struct xwindow)))
        (width uint) (height uint))
 
+(extern ulong x_image_width (ximage (* (struct ximage))))
+(extern ulong x_image_height (ximage (* (struct ximage))))
+
 (extern int
        x_bytes_into_image
        (vector (* uchar)) (length int) (ximage (* (struct ximage))))
index a1fc38a0ca9e98cc16d6fbc59e4c8c4459c62e8d..895f84e640b2a88faa222eb7e6c9192679fdff1b 100644 (file)
@@ -800,6 +800,20 @@ x_create_image (struct xwindow * xw, uint width, uint height)
            bitmap_pad,
            bytes_per_line)));
 }
+\f
+unsigned long
+x_image_width (struct ximage * ximage)
+{
+  XImage * image = (XI_IMAGE (ximage));
+  return (image -> width);
+}
+
+unsigned long
+x_image_height (struct ximage * ximage)
+{
+  XImage * image = (XI_IMAGE (ximage));
+  return (image -> height);
+}
 
 int
 x_bytes_into_image (unsigned char * vector, int length, struct ximage *ximage)