From 5145dd3aa0c02c9fc496d1432fc4410674206e1d Mon Sep 17 00:00:00 2001
From: Bryan Newbold <bnewbold@robocracy.org>
Date: Mon, 20 Feb 2017 00:05:31 -0800
Subject: Import Upstream version 3a2

---
 color.scm | 36 ++++++++++++++++++++----------------
 1 file changed, 20 insertions(+), 16 deletions(-)

(limited to 'color.scm')

diff --git a/color.scm b/color.scm
index 7f80fe5..bf8a921 100644
--- a/color.scm
+++ b/color.scm
@@ -71,8 +71,8 @@
 ;;@cindex tristimulus
 ;;The @dfn{tristimulus} color spaces are those whose component values
 ;;are proportional measurements of light intensity.  The CIEXYZ(1931)
-;;system provides 3 sets of spectra to convolve with a spectrum of
-;;interest.  The result of those convolutions is coordinates in CIEXYZ
+;;system provides 3 sets of spectra to dot-product with a spectrum of
+;;interest.  The result of those dot-products is coordinates in CIEXYZ
 ;;space.  All tristimuls color spaces are related to CIEXYZ by linear
 ;;transforms, namely matrix multiplication.  Of the color spaces listed
 ;;here, CIEXYZ and RGB709 are tristimulus spaces.
@@ -81,7 +81,7 @@
 ;;The CIEXYZ color space covers the full @dfn{gamut}.
 ;;It is the basis for color-space conversions.
 ;;
-;;CIEXYZ is a list of three inexact numbers between 0 and 1.1.
+;;CIEXYZ is a list of three inexact numbers between 0.0 and 1.1.
 ;;'(0. 0. 0.) is black; '(1. 1. 1.) is white.
 ;;@end deftp
 
@@ -129,7 +129,7 @@
 ;;high definition television signals.
 ;;
 ;;An RGB709 color is represented by a list of three inexact numbers
-;;between 0 and 1.  '(0. 0. 0.) is black '(1. 1. 1.) is white.
+;;between 0.0 and 1.0.  '(0. 0. 0.) is black '(1. 1. 1.) is white.
 ;;@end deftp
 
 ;;@body
@@ -168,7 +168,7 @@
 ;;range of distances (6:1) in the L*a*b* and L*u*v* spaces than in
 ;;tristimulus spaces (80:1).  For this reason, color distances are
 ;;computed in L*a*b* (or L*C*h).
-  
+
 ;;@deftp {Color Space} L*a*b*
 ;;Is a CIE color space which better matches the human visual system's
 ;;perception of color.  It is a list of three numbers:
@@ -527,16 +527,17 @@
 	(else (eqv? (car typ) (color:encoding obj)))))
 ;@
 (define (make-color space . args)
-  (case space
-    ((CIEXYZ) (CIEXYZ->color args))
-    ((RGB709) (RGB709->color args))
-    ((L*a*b*) (L*a*b*->color args))
-    ((L*u*v*) (L*u*v*->color args))
-    ((L*C*h)  (L*C*h->color args))
-    ((sRGB)   (sRGB->color args))
-    ((xRGB)  (apply xRGB->color args))
-    ((e-sRGB) (e-sRGB->color args))
-    (else (slib:error 'make-color ': 'not 'space? space))))
+  (apply (case space
+	   ((CIEXYZ) CIEXYZ->color)
+	   ((RGB709) RGB709->color)
+	   ((L*a*b*) L*a*b*->color)
+	   ((L*u*v*) L*u*v*->color)
+	   ((L*C*h)  L*C*h->color)
+	   ((sRGB)   sRGB->color)
+	   ((xRGB)   xRGB->color)
+	   ((e-sRGB) e-sRGB->color)
+	   (else (slib:error 'make-color ': 'not 'space? space)))
+	 args))
 ;@
 (define color-space color:encoding)
 ;@
@@ -620,7 +621,7 @@
 	   ((CIELab) (color:L*a*b* x y z))
 	   ((CIELuv) (color:L*u*v* x y z))
 	   ((CIELCh) (color:L*C*h  x y z))
-	   ((RGBi			; Xlib - C Language X Interface
+	   ((RGBi		       ; Xlib - C Language X Interface
 	     RGB709) (color:RGB709 x y z))
 	   (else #f)))
 	((eqv? 4 (sscanf str " %[sRGBSrgb]:%d/%d/%d" coding x y z))
@@ -637,6 +638,9 @@
 	     xRGB
 	     sRGBx)  (xRGB->color x))
 	   (else #f)))
+	((and (eqv? 1 (sscanf str " #%6[0-9a-fA-F]%[0-9a-fA-F]" x y))
+	      (eqv? 6 (string-length x)))
+	 (xRGB->color (string->number x 16)))
 	((and (eqv? 2 (sscanf str " %[#0xX]%6[0-9a-fA-F]%[0-9a-fA-F]"
 			      coding x y))
 	      (eqv? 6 (string-length x))
-- 
cgit v1.2.3