From 2b45c1f2749523ac1572c7d91de1d3b650b6c660 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 2 Nov 2024 18:15:25 +0200 Subject: [PATCH] Fix color-lightening and darkening calculations * lisp/color.el (color-lighten-hsl): Fix calculations (bug#74055). * test/lisp/color-tests.el (color-tests-lighten-hsl) (color-tests-lighten-name, color-tests-darken-hsl) (color-tests-darken-name): Adjust test results. (cherry picked from commit 435d7d4292e6803405c1ea65c73693f20eea2a58) --- lisp/color.el | 6 +++++- test/lisp/color-tests.el | 17 +++++++---------- 2 files changed, 12 insertions(+), 11 deletions(-) diff --git a/lisp/color.el b/lisp/color.el index 186f1bd9f9a..007504043cc 100644 --- a/lisp/color.el +++ b/lisp/color.el @@ -446,7 +446,11 @@ See `color-desaturate-hsl'." Given a color defined in terms of hue, saturation, and luminance \(arguments H, S, and L), return a color that is PERCENT lighter. Returns a list (HUE SATURATION LUMINANCE)." - (list H S (color-clamp (+ L (/ percent 100.0))))) + (let ((p (/ percent 100.0))) + (if (> p 0.0) + (setq L (* L (- 1.0 p))) + (setq p (- (* L (abs p))))) + (list H S (color-clamp (+ L p))))) (defun color-lighten-name (name percent) "Make a color with a specified NAME lighter by PERCENT. diff --git a/test/lisp/color-tests.el b/test/lisp/color-tests.el index bc897edc702..63cb024bb8d 100644 --- a/test/lisp/color-tests.el +++ b/test/lisp/color-tests.el @@ -220,32 +220,29 @@ (ert-deftest color-tests-lighten-hsl () (should (equal (color-lighten-hsl 360 0.5 0.5 0) '(360 0.5 0.5))) - (should (equal (color-lighten-hsl 360 0.5 0.5 -10) '(360 0.5 0.4))) + (should (equal (color-lighten-hsl 360 0.5 0.5 -10) '(360 0.5 0.45))) (should (equal (color-lighten-hsl 360 0.5 0.5 -500) '(360 0.5 0.0))) - (should - (color-tests--approx-equal - (color-lighten-hsl 120 0.5 0.8 5) '(120 0.5 0.85))) - (should - (equal (color-lighten-hsl 120 0.5 0.8 500) '(120 0.5 1.0)))) + (should (equal (color-lighten-hsl 120 0.5 0.8 5) '(120 0.5 0.81))) + (should (equal (color-lighten-hsl 120 0.5 0.8 500) '(120 0.5 1.0)))) (ert-deftest color-tests-lighten-name () (should (equal (color-lighten-name "black" 100) "#ffffffffffff")) (should (equal (color-lighten-name "white" 100) "#ffffffffffff")) (should (equal (color-lighten-name "red" 0) "#ffff00000000")) - (should (equal (color-lighten-name "red" 10) "#ffff33323332"))) + (should (equal (color-lighten-name "red" 10) "#ffff19991999"))) (ert-deftest color-tests-darken-hsl () (should (equal (color-darken-hsl 360 0.5 0.5 0) '(360 0.5 0.5))) - (should (equal (color-darken-hsl 360 0.5 0.5 -10) '(360 0.5 0.6))) + (should (equal (color-darken-hsl 360 0.5 0.5 -10) '(360 0.5 0.55))) (should (equal (color-darken-hsl 360 0.5 0.5 -500) '(360 0.5 1.0))) - (should (equal (color-darken-hsl 120 0.5 0.8 5) '(120 0.5 0.75))) + (should (equal (color-darken-hsl 120 0.5 0.8 5) '(120 0.5 0.76))) (should (equal (color-darken-hsl 120 0.5 0.8 500) '(120 0.5 0.0)))) (ert-deftest color-tests-darken-name () (should (equal (color-darken-name "black" 100) "#000000000000")) (should (equal (color-darken-name "white" 100) "#000000000000")) (should (equal (color-darken-name "red" 0) "#ffff00000000")) - (should (equal (color-darken-name "red" 10) "#cccc00000000"))) + (should (equal (color-darken-name "red" 10) "#e66500000000"))) (ert-deftest color-tests-oklab-to-xyz () (should (color-tests--approx-equal (color-oklab-to-xyz 0 0 0) '(0.0 0.0 0.0))) -- 2.39.5