;;; "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 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. ;;@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.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.0 and 1.0. '(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) (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) ;@ (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? 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)) (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)