diff options
Diffstat (limited to 'color.scm')
| -rwxr-xr-x[-rw-r--r--] | color.scm | 15 |
1 files changed, 8 insertions, 7 deletions
diff --git a/color.scm b/color.scm index bf8a921..08b3ec2 100644..100755 --- a/color.scm +++ b/color.scm @@ -22,6 +22,7 @@ (require 'scanf) (require 'printf) (require 'string-case) +(require 'multiarg-apply) (define color:rtd (make-record-type "color" @@ -221,7 +222,7 @@ (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 + (CIEXYZ->L*a*b* (L*a*b*->CIEXYZ (color:coordinates color) (color:white-point color)) (wp)))) ((L*u*v*) (CIEXYZ->L*a*b* (L*u*v*->CIEXYZ (color:coordinates color) @@ -585,19 +586,19 @@ (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" + ((L*a*b*) (apply sprintf #f "CIELab:%.2f/%.2f/%.2f" (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" + ((L*u*v*) (apply sprintf #f "CIELuv:%.2f/%.2f/%.2f" (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" + ((L*C*h) (apply sprintf #f "CIELCh:%.2f/%.2f/%.2f" (if (equal? CIEXYZ:D65 (color:white-point color)) (color:coordinates color) (L*a*b*->L*C*h @@ -655,9 +656,9 @@ (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) + (apply L*a*b*:DE*94 + (color->L*a*b* color1) + (color->L*a*b* color2) parametric-factors)) ;@ (define (CMC:DE* color1 color2 . parametric-factors) |