diff options
| author | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:06:40 -0800 |
|---|---|---|
| committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:06:40 -0800 |
| commit | a69c9fb665459e2bfdbda1bf80741a0af31a7faf (patch) | |
| tree | f0bc974f8805049e6b9a4e6864886298fbaa05a4 /color.scm | |
| parent | 4684239efa63dc1b2c1cbe37ef7d3062029f5532 (diff) | |
| download | slib-upstream.tar.gz slib-upstream.zip | |
New upstream version 3b5upstream/3b5upstream
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) |