From a69c9fb665459e2bfdbda1bf80741a0af31a7faf Mon Sep 17 00:00:00 2001 From: Bryan Newbold Date: Mon, 20 Feb 2017 00:06:40 -0800 Subject: New upstream version 3b5 --- color.scm | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) mode change 100644 => 100755 color.scm (limited to 'color.scm') diff --git a/color.scm b/color.scm old mode 100644 new mode 100755 index bf8a921..08b3ec2 --- 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) -- cgit v1.2.3