Import Upstream version 3a1upstream/3a1

1 files changed, 674 insertions, 0 deletions

diff --git a/color.scm b/color.scm
new file mode 100644
index 0000000..7f80fe5
--- /dev/null
+++ b/color.scm
@@ -0,0 +1,674 @@
+;;; "color.scm" color data-type
+;Copyright 2001, 2002 Aubrey Jaffer
+;
+;Permission to copy this software, to modify it, to redistribute it,
+;to distribute modified versions, and to use it for any purpose is
+;granted, subject to the following restrictions and understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warranty or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(require 'record)
+(require 'color-space)
+(require 'scanf)
+(require 'printf)
+(require 'string-case)
+
+(define color:rtd
+  (make-record-type "color"
+		    '(encoding		;symbol
+		      coordinates	;list of coordinates
+		      parameter		;white-point or precision
+		      )))
+
+(define color:construct
+  (record-constructor color:rtd '(encoding coordinates parameter)))
+
+(define color:encoding (record-accessor color:rtd 'encoding))
+
+(define color:coordinates (record-accessor color:rtd 'coordinates))
+
+(define color:parameter (record-accessor color:rtd 'parameter))
+(define color:precision color:parameter)
+
+(define color:color? (record-predicate color:rtd))
+
+(define (color:white-point color)
+  (case (color:encoding color)
+    ((CIEXYZ
+      RGB709
+      sRGB
+      xRGB
+      e-sRGB) CIEXYZ:D65)
+    ((L*a*b*
+      L*u*v*
+      L*C*h)
+     (or (color:parameter color) CIEXYZ:D65))))
+
+;;@subsubheading Measurement-based Color Spaces
+
+(define (color:helper num-of-nums name list->color)
+  (lambda args
+    (define cnt 0)
+    (for-each (lambda (x)
+		(if (and (< cnt num-of-nums) (not (real? x)))
+		    (slib:error name ': 'wrong-type x))
+		(set! cnt (+ 1 cnt)))
+	      args)
+    (or (list->color args)
+	(slib:error name ': 'out-of-range args))))
+
+;;@noindent
+;;@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
+;;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.
+
+;;@deftp {Color Space} CIEXYZ
+;;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.
+;;'(0. 0. 0.) is black; '(1. 1. 1.) is white.
+;;@end deftp
+
+;;@body
+;;@1 must be a list of 3 numbers.  If @1 is valid CIEXYZ coordinates,
+;;then @0 returns the color specified by @1; otherwise returns #f.
+(define (CIEXYZ->color XYZ)
+  (and (eqv? 3 (length XYZ))
+       (apply (lambda (x y z)
+		(and (real? x) (<= -0.001 x)
+		     (real? y) (<= -0.001 y 1.001)
+		     (real? z) (<= -0.001 z)
+		     (color:construct 'CIEXYZ XYZ #f)))
+	      XYZ)))
+
+;;@args x y z
+;;Returns the CIEXYZ color composed of @1, @2, @3.  If the
+;;coordinates do not encode a valid CIEXYZ color, then an error is
+;;signaled.
+(define color:CIEXYZ (color:helper 3 'color:CIEXYZ CIEXYZ->color))
+
+;;@body Returns the list of 3 numbers encoding @1 in CIEXYZ.
+(define (color->CIEXYZ color)
+  (if (not (color:color? color))
+      (slib:error 'color->CIEXYZ ': 'not 'color? color))
+  (case (color:encoding color)
+    ((CIEXYZ) (append (color:coordinates color) '()))
+    ((RGB709) (RGB709->CIEXYZ (color:coordinates color)))
+    ((L*a*b*) (L*a*b*->CIEXYZ (color:coordinates color)
+			      (color:white-point color)))
+    ((L*u*v*) (L*u*v*->CIEXYZ (color:coordinates color)
+			      (color:white-point color)))
+    ((sRGB)     (sRGB->CIEXYZ (color:coordinates color)))
+    ((e-sRGB) (e-sRGB->CIEXYZ (color:precision color)
+			      (color:coordinates color)))
+    ((L*C*h)  (L*a*b*->CIEXYZ (L*C*h->L*a*b* (color:coordinates color))
+			      (color:white-point color)))
+    (else (slib:error 'color->CIEXYZ ': (color:encoding color) color))))
+
+
+;;@deftp {Color Space} RGB709
+;;BT.709-4 (03/00) @cite{Parameter values for the HDTV standards for
+;;production and international programme exchange} specifies parameter
+;;values for chromaticity, sampling, signal format, frame rates, etc., of
+;;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.
+;;@end deftp
+
+;;@body
+;;@1 must be a list of 3 numbers.  If @1 is valid RGB709 coordinates,
+;;then @0 returns the color specified by @1; otherwise returns #f.
+(define (RGB709->color RGB)
+  (and (eqv? 3 (length RGB))
+       (apply (lambda (r g b)
+		(and (real? r) (<= -0.001 r 1.001)
+		     (real? g) (<= -0.001 g 1.001)
+		     (real? b) (<= -0.001 b 1.001)
+		     (color:construct 'RGB709 RGB #f)))
+	      RGB)))
+
+;;@args r g b
+;;Returns the RGB709 color composed of @1, @2, @3.  If the
+;;coordinates do not encode a valid RGB709 color, then an error is
+;;signaled.
+(define color:RGB709 (color:helper 3 'color:RGB709 RGB709->color))
+
+;;@body Returns the list of 3 numbers encoding @1 in RGB709.
+(define (color->RGB709 color)
+  (if (not (color:color? color))
+      (slib:error 'color->RGB709 ': 'not 'color? color))
+  (case (color:encoding color)
+    ((RGB709) (append (color:coordinates color) '()))
+    ((CIEXYZ) (CIEXYZ->RGB709 (color:coordinates color)))
+    (else     (CIEXYZ->RGB709 (color->CIEXYZ color)))))
+
+;;@subsubheading Perceptual Uniformity
+
+;;@noindent
+;;Although properly encoding the chromaticity, tristimulus spaces do not
+;;match the logarithmic response of human visual systems to intensity.
+;;Minimum detectable differences between colors correspond to a smaller
+;;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:
+
+;;@itemize @bullet
+;;@item
+;;0 <= L* <= 100 (CIE @dfn{Lightness})
+
+;;@item
+;;-500 <= a* <= 500
+;;@item
+;;-200 <= b* <= 200
+;;@end itemize
+;;@end deftp
+
+;;@args L*a*b* white-point
+;;@1 must be a list of 3 numbers.  If @1 is valid L*a*b* coordinates,
+;;then @0 returns the color specified by @1; otherwise returns #f.
+(define (L*a*b*->color L*a*b* . white-point)
+  (and (list? L*a*b*)
+       (eqv? 3 (length L*a*b*))
+       (<= 0 (length white-point) 1)
+       (apply (lambda (L* a* b*)
+		(and (real? L*) (<= 0 L* 100)
+		     (real? a*) (<= -500 a* 500)
+		     (real? b*) (<= -200 b* 200)
+		     (color:construct
+		      'L*a*b* L*a*b*
+		      (if (null? white-point) #f
+			  (color->CIEXYZ (car white-point))))))
+	      L*a*b*)))
+
+;;@args L* a* b* white-point
+;;Returns the L*a*b* color composed of @1, @2, @3 with @4.
+;;@args L* a* b*
+;;Returns the L*a*b* color composed of @1, @2, @3.  If the coordinates
+;;do not encode a valid L*a*b* color, then an error is signaled.
+(define color:L*a*b* (color:helper 3 'color:L*a*b* L*a*b*->color))
+
+;;@args color white-point
+;;Returns the list of 3 numbers encoding @1 in L*a*b* with @2.
+;;@args color
+;;Returns the list of 3 numbers encoding @1 in L*a*b*.
+(define (color->L*a*b* color . white-point)
+  (define (wp) (if (null? white-point)
+		   CIEXYZ:D65
+		   (color:coordinates (car white-point))))
+  (if (not (color:color? color))
+      (slib:error 'color->L*a*b* ': 'not 'color? color))
+  (case (color:encoding color)
+    ((L*a*b*) (if (equal? (wp) (color:white-point color))
+		  (append (color:coordinates color) '())
+		  (CIEXYZ->L*a*b* (L*a*b*->CIEXYZ color
+						  (color:white-point color))
+				  (wp))))
+    ((L*u*v*) (CIEXYZ->L*a*b* (L*u*v*->CIEXYZ (color:coordinates color)
+					      (color:white-point color))
+			      (wp)))
+    ((L*C*h)  (if (equal? (wp) (color:white-point color))
+		  (L*C*h->L*a*b* (color:coordinates color))
+		  (CIEXYZ->L*a*b* (L*a*b*->CIEXYZ
+				   (L*C*h->L*a*b* (color:coordinates color))
+				   (color:white-point color))
+				  (wp))))
+    ((CIEXYZ) (CIEXYZ->L*a*b* (color:coordinates color) (wp)))
+    (else     (CIEXYZ->L*a*b* (color->CIEXYZ color) (wp)))))
+
+;;@deftp {Color Space} L*u*v*
+;;Is another CIE encoding designed to better match the human visual
+;;system's perception of color.
+;;@end deftp
+
+;;@args L*u*v* white-point
+;;@1 must be a list of 3 numbers.  If @1 is valid L*u*v* coordinates,
+;;then @0 returns the color specified by @1; otherwise returns #f.
+(define (L*u*v*->color L*u*v* . white-point)
+  (and (list? L*u*v*)
+       (eqv? 3 (length L*u*v*))
+       (<= 0 (length white-point) 1)
+       (apply (lambda (L* u* v*)
+		(and (real? L*) (<= 0 L* 100)
+		     (real? u*) (<= -500 u* 500)
+		     (real? v*) (<= -200 v* 200)
+		     (color:construct
+		      'L*u*v* L*u*v*
+		      (if (null? white-point) #f
+			  (color->CIEXYZ (car white-point))))))
+	      L*u*v*)))
+
+;;@args L* u* v* white-point
+;;Returns the L*u*v* color composed of @1, @2, @3 with @4.
+;;@args L* u* v*
+;;Returns the L*u*v* color composed of @1, @2, @3.  If the coordinates
+;;do not encode a valid L*u*v* color, then an error is signaled.
+(define color:L*u*v* (color:helper 3 'color:L*u*v* L*u*v*->color))
+
+;;@args color white-point
+;;Returns the list of 3 numbers encoding @1 in L*u*v* with @2.
+;;@args color
+;;Returns the list of 3 numbers encoding @1 in L*u*v*.
+(define (color->L*u*v* color . white-point)
+  (define (wp) (if (null? white-point)
+		   (color:white-point color)
+		   (car white-point)))
+  (if (not (color:color? color))
+      (slib:error 'color->L*u*v* ': 'not 'color? color))
+  (case (color:encoding color)
+    ((L*u*v*) (append (color:coordinates color) '()))
+    ((L*a*b*) (CIEXYZ->L*u*v* (L*a*b*->CIEXYZ (color:coordinates color)
+					      (color:white-point color))
+			      (wp)))
+    ((L*C*h)  (CIEXYZ->L*u*v*
+	       (L*a*b*->CIEXYZ (L*C*h->L*a*b* (color:coordinates color))
+			       (color:white-point color))
+	       (wp)))
+    ((CIEXYZ) (CIEXYZ->L*u*v* (color:coordinates color) (wp)))
+    (else     (CIEXYZ->L*u*v* (color->CIEXYZ color) (wp)))))
+
+;;@subsubheading Cylindrical Coordinates
+
+;;@noindent
+;;HSL (Hue Saturation Lightness), HSV (Hue Saturation Value), HSI (Hue
+;;Saturation Intensity) and HCI (Hue Chroma Intensity) are cylindrical
+;;color spaces (with angle hue).  But these spaces are all defined in
+;;terms device-dependent RGB spaces.
+
+;;@noindent
+;;One might wonder if there is some fundamental reason why intuitive
+;;specification of color must be device-dependent.  But take heart!  A
+;;cylindrical system can be based on L*a*b* and is used for predicting how
+;;close colors seem to observers.
+
+;;@deftp {Color Space} L*C*h
+;;Expresses the *a and b* of L*a*b* in polar coordinates.  It is a list of
+;;three numbers:
+
+;;@itemize @bullet
+;;@item
+;;0 <= L* <= 100 (CIE @dfn{Lightness})
+
+;;@item
+;;C* (CIE @dfn{Chroma}) is the distance from the neutral (gray) axis.
+;;@item
+;;0 <= h <= 360 (CIE @dfn{Hue}) is the angle.
+;;@end itemize
+;;
+;;The colors by quadrant of h are:
+
+;;@multitable @columnfractions .20 .60 .20
+;;@item 0 @tab red, orange, yellow @tab 90
+;;@item 90 @tab yellow, yellow-green, green @tab 180
+;;@item 180 @tab green, cyan (blue-green), blue @tab 270
+;;@item 270 @tab blue, purple, magenta @tab 360
+;;@end multitable
+
+;;@end deftp
+
+
+;;@args L*C*h white-point
+;;@1 must be a list of 3 numbers.  If @1 is valid L*C*h coordinates,
+;;then @0 returns the color specified by @1; otherwise returns #f.
+(define (L*C*h->color L*C*h . white-point)
+  (and (list? L*C*h)
+       (eqv? 3 (length L*C*h))
+       (<= 0 (length white-point) 1)
+       (apply (lambda (L* C* h)
+		(and (real? L*) (<= 0 L* 100)
+		     (real? C*) (<= 0 C*)
+		     (real? h)  (<= 0 h 360)
+		     (color:construct
+		      'L*C*h L*C*h
+		      (if (null? white-point) #f
+			  (color->CIEXYZ (car white-point))))))
+	      L*C*h)))
+
+;;@args L* C* h white-point
+;;Returns the L*C*h color composed of @1, @2, @3 with @4.
+;;@args L* C* h
+;;Returns the L*C*h color composed of @1, @2, @3.  If the coordinates
+;;do not encode a valid L*C*h color, then an error is signaled.
+(define color:L*C*h (color:helper 3 'color:L*C*h L*C*h->color))
+
+;;@args color white-point
+;;Returns the list of 3 numbers encoding @1 in L*C*h with @2.
+;;@args color
+;;Returns the list of 3 numbers encoding @1 in L*C*h.
+(define (color->L*C*h color . white-point)
+  (if (not (color:color? color))
+      (slib:error 'color->L*C*h ': 'not 'color? color))
+  (if (and (eqv? 'L*C*h (color:encoding color))
+	   (equal? (color:white-point color)
+		   (if (null? white-point)
+		       CIEXYZ:D65
+		       (color:coordinates (car white-point)))))
+      (append (color:coordinates color) '())
+      (L*a*b*->L*C*h (apply color->L*a*b* color white-point))))
+
+;;@subsubheading Digital Color Spaces
+
+;;@noindent
+;;The color spaces discussed so far are impractical for image data because
+;;of numerical precision and computational requirements.  In 1998 the IEC
+;;adopted @cite{A Standard Default Color Space for the Internet - sRGB}
+;;(@url{http://www.w3.org/Graphics/Color/sRGB}).  sRGB was cleverly
+;;designed to employ the 24-bit (256x256x256) color encoding already in
+;;widespread use; and the 2.2 gamma intrinsic to CRT monitors.
+
+;;@noindent
+;;Conversion from CIEXYZ to digital (sRGB) color spaces is accomplished by
+;;conversion first to a RGB709 tristimulus space with D65 white-point;
+;;then each coordinate is individually subjected to the same non-linear
+;;mapping.  Inverse operations in the reverse order create the inverse
+;;transform.
+
+;;@deftp {Color Space} sRGB
+;;Is "A Standard Default Color Space for the Internet".  Most display
+;;monitors will work fairly well with sRGB directly.  Systems using ICC
+;;profiles
+;;@ftindex ICC Profile
+;;@footnote{
+;;@noindent
+;;A comprehensive encoding of transforms between CIEXYZ and device color
+;;spaces is the International Color Consortium profile format,
+;;ICC.1:1998-09:
+
+;;@quotation
+;;The intent of this format is to provide a cross-platform device profile
+;;format.  Such device profiles can be used to translate color data
+;;created on one device into another device's native color space.
+;;@end quotation
+;;}
+;;should work very well with sRGB.
+
+;;An sRGB color is a triplet of integers ranging 0 to 255.  D65 is the
+;;white-point for sRGB.
+;;@end deftp
+
+;;@body
+;;@1 must be a list of 3 numbers.  If @1 is valid sRGB coordinates,
+;;then @0 returns the color specified by @1; otherwise returns #f.
+(define (sRGB->color RGB)
+  (and (eqv? 3 (length RGB))
+       (apply (lambda (r g b)
+		(and  (integer? r) (<= 0 r 255)
+		      (integer? g) (<= 0 g 255)
+		      (integer? b) (<= 0 b 255)
+		      (color:construct 'sRGB RGB #f)))
+	      RGB)))
+
+;;@args r g b
+;;Returns the sRGB color composed of @1, @2, @3.  If the
+;;coordinates do not encode a valid sRGB color, then an error is
+;;signaled.
+(define color:sRGB (color:helper 3 'color:sRGB sRGB->color))
+
+;;@deftp {Color Space} xRGB
+;;Represents the equivalent sRGB color with a single 24-bit integer.  The
+;;most significant 8 bits encode red, the middle 8 bits blue, and the
+;;least significant 8 bits green.
+;;@end deftp
+
+;;@body
+;;Returns the list of 3 integers encoding @1 in sRGB.
+(define (color->sRGB color)
+  (if (not (color:color? color))
+      (slib:error 'color->sRGB ': 'not 'color? color))
+  (case (color:encoding color)
+    ((CIEXYZ) (CIEXYZ->sRGB (color:coordinates color)))
+    ((sRGB)   (append (color:coordinates color) '()))
+    (else     (CIEXYZ->sRGB (color->CIEXYZ color)))))
+
+;;@body Returns the 24-bit integer encoding @1 in sRGB.
+(define (color->xRGB color) (sRGB->xRGB (color->sRGB color)))
+
+;;@args k
+;;Returns the sRGB color composed of the 24-bit integer @1.
+(define (xRGB->color xRGB)
+  (and (integer? xRGB) (<= 0 xRGB #xffffff)
+       (sRGB->color (xRGB->sRGB xRGB))))
+
+
+;;@deftp {Color Space} e-sRGB
+;;Is "Photography - Electronic still picture imaging - Extended sRGB color
+;;encoding" (PIMA 7667:2001).  It extends the gamut of sRGB; and its
+;;higher precision numbers provide a larger dynamic range.
+;;
+;;A triplet of integers represent e-sRGB colors.  Three precisions are
+;;supported:
+
+;;@table @r
+;;@item e-sRGB10
+;;0 to 1023
+;;@item e-sRGB12
+;;0 to 4095
+;;@item e-sRGB16
+;;0 to 65535
+;;@end table
+;;@end deftp
+
+(define (esRGB->color prec-RGB)
+  (and (eqv? 4 (length prec-RGB))
+       (let ((range (and (pair? prec-RGB)
+			 (case (car prec-RGB)
+			   ((10) 1023)
+			   ((12) 4095)
+			   ((16) 65535)
+			   (else #f)))))
+	 (apply (lambda (precision r g b)
+		  (and  (integer? r) (<= 0 r range)
+			(integer? g) (<= 0 g range)
+			(integer? b) (<= 0 b range)
+			(color:construct 'e-sRGB (cdr prec-RGB) precision)))
+		prec-RGB))))
+
+;;@body @1 must be the integer 10, 12, or 16.  @2 must be a list of 3
+;;numbers.  If @2 is valid e-sRGB coordinates, then @0 returns the color
+;;specified by @2; otherwise returns #f.
+(define (e-sRGB->color precision RGB)
+  (esRGB->color (cons precision RGB)))
+
+;;@args 10 r g b
+;;Returns the e-sRGB10 color composed of integers @2, @3, @4.
+;;@args 12 r g b
+;;Returns the e-sRGB12 color composed of integers @2, @3, @4.
+;;@args 16 r g b
+;;Returns the e-sRGB16 color composed of integers @2, @3, @4.
+;;If the coordinates do not encode a valid e-sRGB color, then an error
+;;is signaled.
+(define color:e-sRGB (color:helper 4 'color:e-sRGB esRGB->color))
+
+;;@body @1 must be the integer 10, 12, or 16.  @0 returns the list of 3
+;;integers encoding @2 in sRGB10, sRGB12, or sRGB16.
+(define (color->e-sRGB precision color)
+  (case precision
+    ((10 12 16)
+     (if (not (color:color? color))
+	 (slib:error 'color->e-sRGB ': 'not 'color? color)))
+    (else (slib:error 'color->e-sRGB ': 'invalid 'precision precision)))
+  (case (color:encoding color)
+    ((e-sRGB) (e-sRGB->e-sRGB (color:precision color)
+			      (color:coordinates color)
+			      precision))
+    ((sRGB)     (sRGB->e-sRGB precision (color:coordinates color)))
+    (else     (CIEXYZ->e-sRGB precision (color->CIEXYZ color)))))
+
+;;;; Polytypic Colors
+
+;;; The rest of documentation is in "slib.texi"
+;@
+(define D65 (CIEXYZ->color CIEXYZ:D65))
+(define D50 (CIEXYZ->color CIEXYZ:D50))
+;@
+(define (color? obj . typ)
+  (cond ((not (color:color? obj)) #f)
+	((null? typ) #t)
+	(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))))
+;@
+(define color-space color:encoding)
+;@
+(define (color-precision color)
+  (if (not (color:color? color))
+      (slib:error 'color-precision ': 'not 'color? color))
+  (case (color:encoding color)
+    ((e-sRGB) (color:precision color))
+    ((sRGB)   8)
+    (else     #f)))
+;@
+(define (color-white-point color)
+  (if (not (color:color? color))
+      (slib:error 'color-white-point ': 'not 'color? color))
+  (case (color:encoding color)
+    ((L*a*b*) (color:CIEXYZ (color:white-point color)))
+    ((L*u*v*) (color:CIEXYZ (color:white-point color)))
+    ((L*C*h)  (color:CIEXYZ (color:white-point color)))
+    ((RGB709) D65)
+    ((sRGB)   D65)
+    ((e-sRGB) D65)
+    (else #f)))
+;@
+(define (convert-color color encoding . opt-arg)
+  (define (noarg)
+    (if (not (null? opt-arg))
+	(slib:error 'convert-color ': 'too-many 'arguments opt-arg)))
+  (if (not (color:color? color))
+      (slib:error 'convert-color ': 'not 'color? color))
+  (case encoding
+    ((CIEXYZ) (noarg) (CIEXYZ->color (color->CIEXYZ color)))
+    ((RGB709) (noarg) (RGB709->color (color->RGB709 color)))
+    ((sRGB)   (noarg) (sRGB->color   (color->sRGB color)))
+    ((e-sRGB) (e-sRGB->color (car opt-arg) (color->e-sRGB (car opt-arg) color)))
+    ((L*a*b*) (apply L*a*b*->color (color->L*a*b* color) opt-arg))
+    ((L*u*v*) (apply L*u*v*->color (color->L*u*v* color) opt-arg))
+    ((L*C*h)  (apply L*C*h->color  (color->L*C*h color) opt-arg))
+    (else (slib:error 'convert-color ': encoding '?))))
+
+;;; External color representations
+;@
+(define (color->string color)
+  (if (not (color:color? color))
+      (slib:error 'color->string ': 'not 'color? color))
+  (case (color:encoding color)
+    ((CIEXYZ) (apply sprintf #f "CIEXYZ:%g/%g/%g"
+		     (color:coordinates color)))
+    ((L*a*b*) (apply sprintf #f "CIELab:%.4f/%.4f/%.4f"
+		     (if (equal? CIEXYZ:D65 (color:white-point color))
+			 (color:coordinates color)
+			 (CIEXYZ->L*a*b* (L*a*b*->CIEXYZ
+					  (color:coordinates color)
+					  (color:white-point color))))))
+    ((L*u*v*) (apply sprintf #f "CIELuv:%.4f/%.4f/%.4f"
+		     (if (equal? CIEXYZ:D65 (color:white-point color))
+			 (color:coordinates color)
+			 (CIEXYZ->L*u*v* (L*u*v*->CIEXYZ
+					  (color:coordinates color)
+					  (color:white-point color))))))
+    ((L*C*h)  (apply sprintf #f "CIELCh:%.4f/%.4f/%.4f"
+		     (if (equal? CIEXYZ:D65 (color:white-point color))
+			 (color:coordinates color)
+			 (L*a*b*->L*C*h
+			  (CIEXYZ->L*a*b* (L*a*b*->CIEXYZ
+					   (L*C*h->L*a*b*
+					    (color:coordinates color))
+					   (color:white-point color)))))))
+    ((RGB709) (apply sprintf #f "RGBi:%g/%g/%g" (color:coordinates color)))
+    ((sRGB)   (apply sprintf #f "sRGB:%d/%d/%d" (color:coordinates color)))
+    ((e-sRGB) (apply sprintf #f "e-sRGB%d:%d/%d/%d"
+		     (color:precision color) (color:coordinates color)))
+    (else (slib:error 'color->string ': (color:encoding color) color))))
+;@
+(define (string->color str)
+  (define prec #f) (define coding #f)
+  (define x #f) (define y #f) (define z #f)
+  (cond ((eqv? 4 (sscanf str " %[CIEXYZciexyzLABUVlabuvHhRrGg709]:%f/%f/%f"
+			 coding x y z))
+	 (case (string-ci->symbol coding)
+	   ((CIEXYZ) (color:CIEXYZ x y z))
+	   ((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
+	     RGB709) (color:RGB709 x y z))
+	   (else #f)))
+	((eqv? 4 (sscanf str " %[sRGBSrgb]:%d/%d/%d" coding x y z))
+	 (case (string-ci->symbol coding)
+	   ((sRGB)   (color:sRGB x y z))
+	   (else #f)))
+	((eqv? 5 (sscanf str " %[-esRGBESrgb]%d:%d/%d/%d" coding prec x y z))
+	 (case (string-ci->symbol coding)
+	   ((e-sRGB) (color:e-sRGB prec x y z))
+	   (else #f)))
+	((eqv? 2 (sscanf str " %[sRGBxXXRGB]:%6x%[/0-9a-fA-F]" coding x y))
+	 (case (string-ci->symbol coding)
+	   ((sRGB
+	     xRGB
+	     sRGBx)  (xRGB->color x))
+	   (else #f)))
+	((and (eqv? 2 (sscanf str " %[#0xX]%6[0-9a-fA-F]%[0-9a-fA-F]"
+			      coding x y))
+	      (eqv? 6 (string-length x))
+	      (member coding '("#" "#x" "0x" "#X" "0X")))
+	 (xRGB->color (string->number x 16)))
+	(else #f)))
+
+;;;; visual color metrics
+;@
+(define (CIE:DE* color1 color2 . white-point)
+  (L*a*b*:DE* (apply color->L*a*b* color1 white-point)
+	      (apply color->L*a*b* color2 white-point)))
+;@
+(define (CIE:DE*94 color1 color2 . parametric-factors)
+  (apply L*C*h:DE*94
+	 (color->L*C*h color1)
+	 (color->L*C*h color2)
+	 parametric-factors))
+;@
+(define (CMC:DE* color1 color2 . parametric-factors)
+  (apply CMC-DE
+	 (color->L*C*h color1)
+	 (color->L*C*h color2)
+	 parametric-factors))
+
+;;; Short names
+
+;; (define CIEXYZ color:CIEXYZ)
+;; (define RGB709 color:RGB709)
+;; (define L*a*b* color:L*a*b*)
+;; (define L*u*v* color:L*u*v*)
+;; (define L*C*h  color:L*C*h)
+;; (define sRGB   color:sRGB)
+;; (define xRGB   xRGB->color)
+;; (define e-sRGB color:e-sRGB)