diff options
Diffstat (limited to 'colorspc.scm')
| -rwxr-xr-x[-rw-r--r--] | colorspc.scm | 32 |
1 files changed, 20 insertions, 12 deletions
diff --git a/colorspc.scm b/colorspc.scm index 723a197..4a17065 100644..100755 --- a/colorspc.scm +++ b/colorspc.scm @@ -300,16 +300,24 @@ (slib:error 'parametric-factors 'not 'number? obj))) ans)) ans) -;@ -(define (L*C*h:DE*94 lch1 lch2 . parametric-factors) - (define C* (sqrt (* (cadr lch1) (cadr lch2)))) ;Geometric mean - (sqrt (apply + (map / - (map (lambda (x) (* x x)) (map - lch1 lch2)) - (list 1 ; S_l - (+ 1 (* .045 C*)) ; S_c - (+ 1 (* .015 C*))) ; S_h - (or (color:process-params parametric-factors) - '(1 1 1)))))) +;;; http://www.brucelindbloom.com/index.html?Eqn_DeltaE_CIE94.html +;@ +(define (L*a*b*:DE*94 lab1 lab2 . parametric-factors) + (define (square x) (* x x)) + (let ((C1 (sqrt (apply + (map square (cdr lab1))))) + (C2 (sqrt (apply + (map square (cdr lab2)))))) + (define dC^2 (square (- C1 C2))) + (sqrt (apply + (map / + (list (square (- (car lab1) (car lab2))) + dC^2 + (- (apply + (map square + (map - (cdr lab1) (cdr lab2)))) + dC^2)) + (list 1 ; S_l + (+ 1 (* .045 C1)) ; S_c + (+ 1 (* .015 C1))) ; S_h + (or (color:process-params parametric-factors) + '(1 1 1))))))) ;;; CMC-DE is designed only for small color-differences. But try to do ;;; something reasonable for large differences. Use bisector (h*) of @@ -463,8 +471,8 @@ (let* ((wlf (inexact->exact (floor wl))) (res (- wl wlf))) (define (interpolate vect idx res) - (+ (* res (vector-ref vect idx)) - (* (- 1 res) (vector-ref vect (+ 1 idx))))) + (+ (* (- 1 res) (vector-ref vect idx)) + (* res (vector-ref vect (+ 1 idx))))) (list (interpolate cie:x-bar wlf res) (interpolate cie:y-bar wlf res) (interpolate cie:z-bar wlf res))) |