Fix graphics bug reported by GJS.

diff --git a/src/x11/x11-device.scm b/src/x11/x11-device.scm
index d9a73532f893294177a9d1f450844c9a9282f303..0feacb35be19765fb0c073d4628024e9c213f930 100644 (file)
--- a/src/x11/x11-device.scm
+++ b/src/x11/x11-device.scm
@@ -44,6 +44,31 @@ USA.
   (+ event-mask:normal (shift-left 1 event-type:take-focus)))
 
 (define user-event-mask:default (shift-left 1 event-type:button-down))
+
+(define (->flovec object)
+  (cond ((flo:flonum? object)
+        object)
+       ((vector-of-type? object number?)
+        (let* ((n (vector-length object))
+               (v (flo:vector-cons n)))
+          (let loop ((i 0))
+            (if (fix:< i n)
+                (begin
+                  (flo:vector-set! v i (->flonum (vector-ref object i)))
+                  (loop (fix:+ i 1)))))
+          v))
+       ((list-of-type?->length object number?)
+        => (lambda (n)
+             (let ((v (flo:vector-cons n)))
+               (let loop ((i 0) (items object))
+                 (if (pair? items)
+                     (begin
+                       (flo:vector-set! v i (->flonum (car items)))
+                       (loop (fix:+ i 1) (cdr items)))))
+               v)))
+       (else
+        (error:wrong-type-argument object "list/vector of numbers"
+                                   '->flovec))))
 \f
 ;;;; X11 graphics device
 
@@ -477,7 +502,9 @@ USA.
                        (->flonum y-end)))
 
 (define (x-graphics/draw-lines device xv yv)
-  (x-graphics-draw-lines (x-graphics-device/xw device) xv yv))
+  (x-graphics-draw-lines (x-graphics-device/xw device)
+                        (->flovec xv)
+                        (->flovec yv)))
 
 (define (x-graphics/draw-point device x y)
   (x-graphics-draw-point (x-graphics-device/xw device)
@@ -485,7 +512,9 @@ USA.
                         (->flonum y)))
 
 (define (x-graphics/draw-points device xv yv)
-  (x-graphics-draw-points (x-graphics-device/xw device) xv yv))
+  (x-graphics-draw-points (x-graphics-device/xw device)
+                         (->flovec xv)
+                         (->flovec yv)))
 
 (define (x-graphics/draw-text device x y string)
   (x-graphics-draw-string (x-graphics-device/xw device)
@@ -610,9 +639,9 @@ USA.
                       360.
                       #t))
 
-(define (x-graphics/fill-polygon device point-vector)
+(define (x-graphics/fill-polygon device points)
   (x-graphics-fill-polygon (x-graphics-device/xw device)
-                          (vector-map ->flonum point-vector)))
+                          (->flovec points)))
 
 (define (x-graphics/copy-area device source-x-left source-y-top width height
                              destination-x-left destination-y-top)

diff --git a/src/x11/x11-graphics.scm b/src/x11/x11-graphics.scm
index 3d0b3623414c3a1c493c15de3deced0a3e5b291b..230615fc6d05977b61d1a553ff3a88f95de42f16 100644 (file)
--- a/src/x11/x11-graphics.scm
+++ b/src/x11/x11-graphics.scm
@@ -139,7 +139,7 @@ USA.
 
 (define (x-graphics-draw-points window x-vector y-vector)
   (let* ((n-points (flo:vector-length x-vector))
-        (points (malloc (* n-points (C-sizeof "XPoint")))))
+        (points (malloc (* n-points (C-sizeof "XPoint")) '|XPoint|)))
     (if (not (= n-points (flo:vector-length y-vector)))
        (error:bad-range-argument y-vector 'x-graphics-draw-points))
     (C-call "x_graphics_draw_points" window x-vector y-vector n-points points)
@@ -147,7 +147,7 @@ USA.
 
 (define (x-graphics-draw-lines window x-vector y-vector)
   (let* ((n-points (flo:vector-length x-vector))
-        (points (malloc (* n-points (C-sizeof "XPoint")))))
+        (points (malloc (* n-points (C-sizeof "XPoint")) '|XPoint|)))
     (if (not (= n-points (flo:vector-length y-vector)))
        (error:bad-range-argument y-vector 'x-graphics-draw-lines))
     (C-call "x_graphics_draw_lines" window x-vector y-vector n-points points)
@@ -179,7 +179,7 @@ USA.
   (let ((length (flo:vector-length vector)))
     (if (not (even? length))
        (error:bad-range-argument vector 'x-graphics-fill-polygon))
-    (let ((points (malloc (* (/ length 2) (C-sizeof "XPoint")))))
+    (let ((points (malloc (* (/ length 2) (C-sizeof "XPoint")) '|XPoint|)))
       (C-call "x_graphics_fill_polygon" window vector length points)
       (free points))))