From 8dd138c0799449b62da81438ec92f04d7b50dbb2 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 11 Jul 1991 03:57:36 +0000
Subject: [PATCH] Rewrite X-STORE-COLORS.  Previously it had unpredictable
 effect since the `flags' component of the XColor structures was not being
 initialized.

---
 v7/src/microcode/x11color.c | 115 ++++++++++++++++++++----------------
 1 file changed, 63 insertions(+), 52 deletions(-)

diff --git a/v7/src/microcode/x11color.c b/v7/src/microcode/x11color.c
index 7ae9c3bcf..dbd10932b 100644
--- a/v7/src/microcode/x11color.c
+++ b/v7/src/microcode/x11color.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11color.c,v 1.1 1991/07/11 02:16:45 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11color.c,v 1.2 1991/07/11 03:57:36 cph Exp $
 
 Copyright (c) 1991 Massachusetts Institute of Technology
 
@@ -336,57 +336,6 @@ DEFINE_PRIMITIVE("X-LOOKUP-COLOR", Prim_x_lookup_color, 3, 3, 0)
   }
 }
 
-static Get_Color(Dest, Source)
-XColor *Dest;
-SCHEME_OBJECT Source;
-{ long flag = 0;
-  SCHEME_OBJECT Temp;
-
-#define SHOULD_BE_INTEGER(offset, field, flag_bit)			\
-{ Temp = VECTOR_REF(Source, offset);					\
-  if (Temp != SHARP_F)							\
-  { if ((! (INTEGER_P (Temp))) || (! (integer_to_long_p (Temp))))	\
-    { error_bad_range_arg (3); }					\
-    else								\
-    { Dest->field = integer_to_long(Temp);				\
-      flag |= flag_bit;							\
-    }									\
-  }									\
-}
-
-  if ((! (VECTOR_P (Source))) || (VECTOR_LENGTH (Source) != 4))
-  { error_bad_range_arg (3);
-  }
-  SHOULD_BE_INTEGER(0, pixel, 0);
-  SHOULD_BE_INTEGER(1, red, DoRed);
-  SHOULD_BE_INTEGER(2, green, DoGreen);
-  SHOULD_BE_INTEGER(3, blue, DoBlue);
-}
-
-DEFINE_PRIMITIVE("X-STORE-COLORS", Prim_x_store_colors, 3, 3, 0)
-{ /* Input: (Scheme) display, colormap, vector of vectors, each of
-     which contains pixel, r, g, b (where r/g/b can be #f or integer)
-  */
-  XColor *ColorVector, *ThisColor;
-  SCHEME_OBJECT Vect, *This_Entry;
-  long Length, i;
-  SCHEME_OBJECT *SingleColor;
-
-  PRIMITIVE_HEADER(3);
-
-  Vect = VECTOR_ARG(3);
-  Length = VECTOR_LENGTH(Vect);
-  Primitive_GC_If_Needed(sizeof(XColor) * Length);
-  ColorVector = (XColor *) Free;
-  SingleColor = VECTOR_LOC(Vect, 0);
-  for (i=0, ThisColor = ColorVector; i < Length; i++)
-  { Get_Color(ThisColor++, *SingleColor++);
-  }
-  XStoreColors
-    (XD_DISPLAY(x_display_arg(1)), arg_integer(2), ColorVector, Length);
-  PRIMITIVE_RETURN(UNSPECIFIC);
-}
-
 DEFINE_PRIMITIVE ("X-STORE-COLOR", Prim_x_store_color, 6, 6,
   "Input: (Scheme) display, colormap, pixel, r, g, b (r/g/b may be #f).")
 {
@@ -413,6 +362,68 @@ DEFINE_PRIMITIVE ("X-STORE-COLOR", Prim_x_store_color, 6, 6,
   XStoreColor ((XD_DISPLAY (x_display_arg (1))), (arg_integer (2)), (&c));
   PRIMITIVE_RETURN (UNSPECIFIC);
 }
+
+#define CONVERT_COLOR_OBJECT(index, color, flag)			\
+{									\
+  SCHEME_OBJECT object = (VECTOR_REF (color_object, (index)));		\
+  if (object != SHARP_F)						\
+    {									\
+      if (! ((INTEGER_P (object)) && (integer_to_long_p (object))))	\
+	goto losing_color_object;					\
+      {									\
+	long value = (integer_to_long (object));			\
+	if ((value < 0) || (value > 65535))				\
+	  goto losing_color_object;					\
+	(colors_scan -> color) = value;					\
+	(colors_scan -> flags) |= (flag);				\
+      }									\
+    }									\
+}
+
+DEFINE_PRIMITIVE ("X-STORE-COLORS", Prim_x_store_colors, 3, 3,
+  "Input: (Scheme) display, colormap, vector of vectors, each of\n\
+which contains pixel, r, g, b (where r/g/b can be #f or integer).")
+{
+  PRIMITIVE_HEADER (3);
+  {
+    SCHEME_OBJECT color_vector = (VECTOR_ARG (3));
+    unsigned long n_colors = (VECTOR_LENGTH (color_vector));
+    XColor * colors = (dstack_alloc ((sizeof (XColor)) * n_colors));
+    {
+      SCHEME_OBJECT * vector_scan = (VECTOR_LOC (color_vector, 0));
+      SCHEME_OBJECT * vector_end = (vector_scan + n_colors);
+      XColor * colors_scan = colors;
+      while (vector_scan < vector_end)
+	{
+	  SCHEME_OBJECT color_object = (*vector_scan++);
+	  if (! ((VECTOR_P (color_object))
+		 && ((VECTOR_LENGTH (color_object)) == 4)))
+	    {
+	    losing_color_object:
+	      error_wrong_type_arg (3);
+	    }
+	  {
+	    SCHEME_OBJECT pixel_object = (VECTOR_REF (color_object, 0));
+	    if (! ((INTEGER_P (pixel_object))
+		   && (integer_to_long_p (pixel_object))))
+	      goto losing_color_object;
+	    (colors_scan -> pixel) = (integer_to_long (pixel_object));
+	  }
+	  (colors_scan -> flags) = 0;
+	  CONVERT_COLOR_OBJECT (1, red, DoRed);
+	  CONVERT_COLOR_OBJECT (2, green, DoGreen);
+	  CONVERT_COLOR_OBJECT (3, blue, DoBlue);
+	  colors_scan += 1;
+	}
+    }
+    XStoreColors
+      ((XD_DISPLAY (x_display_arg (1))),
+       (arg_integer (2)),
+       colors,
+       n_colors);
+  }
+  PRIMITIVE_RETURN (UNSPECIFIC);
+}
 
 DEFINE_PRIMITIVE("X-STORE-NAMED-COLOR", Prim_x_store_named_color, 7, 7, 0)
 { /* Input: (Scheme) display, colormap, color name, pixel, DoRed, DoGreen,
-- 
2.25.1