Added x-graphics-fill-polygon

diff --git a/v7/src/microcode/x11graph.c b/v7/src/microcode/x11graph.c
index 2ee211029d2159354ce3d8f13858e90488768d1c..b67e549ad44e17ff63e82713b037540283440386 100644 (file)
--- a/v7/src/microcode/x11graph.c
+++ b/v7/src/microcode/x11graph.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11graph.c,v 1.23 1992/03/16 19:41:37 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11graph.c,v 1.24 1992/05/13 21:27:12 bal Exp $
 
 Copyright (c) 1989-92 Massachusetts Institute of Technology
 
@@ -552,6 +552,82 @@ DEFINE_PRIMITIVE ("X-GRAPHICS-COPY-AREA", Prim_x_graphics_copy_area, 7, 7, 0)
     PRIMITIVE_RETURN (UNSPECIFIC);
   }
 }
+
+/* PTR
+DEFUN (foreign_malloc, (size), unsigned int size)
+{
+  PTR result = (UX_malloc (size));
+  if (result == 0)
+    error_external_return ();
+  return (result);
+} */
+
+double
+DEFUN (obj_real_number, (obj), SCHEME_OBJECT obj)
+{
+  if (! (REAL_P (obj)))
+    error_external_return ();
+  if (! (real_number_to_double_p (obj)))
+    error_external_return ();
+  return (real_number_to_double (obj));
+}
+
+static unsigned short
+DEFUN (short_x_coordinate, (obj, xw),
+       SCHEME_OBJECT obj AND
+       struct xwindow * xw)
+{
+  float virtual_device_x = (obj_real_number (obj));
+  float device_x = ((XW_X_SLOPE (xw)) * (virtual_device_x - (XW_X_LEFT (xw))));
+  return (short) (ROUND_FLOAT (device_x));
+}
+
+static unsigned short
+DEFUN (short_y_coordinate, (obj, xw),
+       SCHEME_OBJECT obj AND
+       struct xwindow * xw)
+{
+  float virtual_device_y = (obj_real_number (obj));
+  float device_y =
+    ((XW_Y_SLOPE (xw)) * (virtual_device_y - (XW_Y_BOTTOM (xw))));
+  return (((int) ((XW_Y_SIZE (xw)) - 1)) + (ROUND_FLOAT (device_y)));
+}
+
+DEFINE_PRIMITIVE ("X-GRAPHICS-FILL-POLYGON", Prim_x_graphics_fill_polygon, 2, 2, 0)
+{
+  PRIMITIVE_HEADER (2);
+  {
+    XPoint *points, *cur_point;
+    struct xwindow * xw = x_window_arg (1);
+    unsigned int internal_border_width = (XW_INTERNAL_BORDER_WIDTH (xw));
+    SCHEME_OBJECT vector = (ARG_REF (2));
+    long length = (VECTOR_LENGTH (vector));
+    fast SCHEME_OBJECT * scan_source = (& (VECTOR_REF (vector, 0)));
+    fast SCHEME_OBJECT * end_source = (scan_source + length);
+
+    if ((length % 2)!=0) {
+           error_bad_range_arg (1);
+    }
+    /* Warning, no check!!! */
+    points = (XPoint *) malloc((length/2)*sizeof(XPoint));
+    cur_point = points;
+    while (scan_source < end_source) {
+           cur_point->x = (internal_border_width + short_x_coordinate(*(scan_source++),xw));
+           cur_point->y = (internal_border_width + short_y_coordinate(*(scan_source++),xw));
+           cur_point++;
+    }
+    XFillPolygon ((XW_DISPLAY (xw)),
+                 (XW_WINDOW (xw)),
+                 (XW_NORMAL_GC (xw)),
+                 points,
+                 (length/2),
+                 Nonconvex,
+                 CoordModeOrigin);
+    free(points);
+    XFlush (XW_DISPLAY (xw));
+    PRIMITIVE_RETURN (UNSPECIFIC);
+}
+}
 \f
 DEFINE_PRIMITIVE ("X-CREATE-IMAGE", Prim_x_create_image, 3, 3,
   "Arguments: Window, width, height\n\