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.
This commit is contained in:
Eli Zaretskii 2024-11-02 18:15:25 +02:00
parent 99650746d9
commit 435d7d4292
2 changed files with 12 additions and 11 deletions

View file

@ -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.

View file

@ -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)))