Add Oklab color space utility functions in color.el.

* lisp/color.el (color-oklab-to-xyz, color-oklab-to-srgb)
(color-srgb-to-oklab): New functions.  (Bug#70963)

* test/lisp/color-tests.el (color-tests-oklab-to-xyz)
(color-tests-xyz-to-oklab, color-tests-srgb-to-oklab)
(color-tests-oklab-to-srgb): New tests.

(cherry picked from commit c5e5940ba40b801270bbe02b92576eac36f73222)

diff --git a/lisp/color.el b/lisp/color.el
index 078c12fbf47ef620e1f1bd5ee39aa25c26fa80d1..5ba73f4a879328eafa4ba1ea0dbcec5781ed53dd 100644 (file)
--- a/lisp/color.el
+++ b/lisp/color.el
@@ -29,7 +29,8 @@
 ;;
 ;; Supported color representations include RGB (red, green, blue), HSV
 ;; (hue, saturation, value), HSL (hue, saturation, luminance), sRGB,
-;; CIE XYZ, and CIE L*a*b* color components.
+;; CIE XYZ, CIE L*a*b* color components, and the Oklab perceptual color
+;; space.
 
 ;;; Code:
 
@@ -368,6 +369,44 @@ returned by `color-srgb-to-lab' or `color-xyz-to-lab'."
                  (expt (/ ΔH′ (* Sh kH)) 2.0)
                  (* Rt (/ ΔC′ (* Sc kC)) (/ ΔH′ (* Sh kH)))))))
 
+(defun color-oklab-to-xyz (l a b)
+  "Convert the OkLab color represented by L A B to CIE XYZ.
+Oklab is a perceptual color space created by Björn Ottosson
+<https://bottosson.github.io/posts/oklab/>. It has the property that
+changes in the hue and saturation of a color can be made while maintaining
+the same perceived lightness."
+  (let ((ll (expt (+ (* 1.0 l) (* 0.39633779 a) (* 0.21580376 b)) 3))
+        (mm (expt (+ (* 1.00000001 l) (* -0.10556134 a) (* -0.06385417 b)) 3))
+        (ss (expt (+ (* 1.00000005 l) (* -0.08948418 a) (* -1.29148554 b)) 3)))
+    (list (+ (* ll 1.22701385) (* mm -0.55779998) (* ss 0.28125615))
+          (+ (* ll -0.04058018) (* mm 1.11225687) (* ss -0.07167668))
+          (+ (* ll -0.07638128) (* mm -0.42148198) (* ss 1.58616322)))))
+
+(defun color-xyz-to-oklab (x y z)
+  "Convert the CIE XYZ color represented by X Y Z to Oklab."
+  (let ((ll (+ (* x 0.8189330101) (* y 0.3618667424) (* z -0.1288597137)))
+        (mm (+ (* x 0.0329845436) (* y 0.9293118715) (* z 0.0361456387)))
+        (ss (+ (* x 0.0482003018) (* y 0.2643662691) (* z 0.6338517070))))
+    (let*
+        ((cube-root (lambda (f)
+                      (if (< f 0)
+                         (- (expt (- f) (/ 1.0 3.0)))
+                        (expt f (/ 1.0 3.0)))))
+         (lll (funcall cube-root ll))
+         (mmm (funcall cube-root mm))
+         (sss (funcall cube-root ss)))
+      (list (+ (* lll 0.2104542553) (* mmm 0.7936177850) (* sss -0.0040720468))
+            (+ (* lll 1.9779984951) (* mmm -2.4285922050) (* sss 0.4505937099))
+            (+ (* lll 0.0259040371) (* mmm 0.7827717662) (* sss -0.8086757660))))))
+
+(defun color-oklab-to-srgb (l a b)
+  "Convert the Oklab color represented by L A B to sRGB."
+  (apply #'color-xyz-to-srgb (color-oklab-to-xyz l a b)))
+
+(defun color-srgb-to-oklab (r g b)
+  "Convert the sRGB color R G B to Oklab."
+  (apply #'color-xyz-to-oklab (color-srgb-to-xyz r g b)))
+
 (defun color-clamp (value)
   "Make sure VALUE is a number between 0.0 and 1.0 inclusive."
   (min 1.0 (max 0.0 value)))

diff --git a/test/lisp/color-tests.el b/test/lisp/color-tests.el
index 9b6b8c1f8dca335c0c6aa408f357c73264eac84a..0f53e4332a4ea145e8c1351114ccb5b85da50826 100644 (file)
--- a/test/lisp/color-tests.el
+++ b/test/lisp/color-tests.el
@@ -247,5 +247,38 @@
   (should (equal (color-darken-name "red" 0) "#ffff00000000"))
   (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)))
+  (should (color-tests--approx-equal (color-oklab-to-xyz 1.0 0.0 0.0)
+                                     '(0.95047005 1.0 1.0883001)))
+  (should (color-tests--approx-equal (color-oklab-to-xyz 0.450 1.236 -0.019) '(1.000604 -0.000008 -0.000038)))
+  (should (color-tests--approx-equal (color-oklab-to-xyz 0.922 -0.671 0.263) '(0.000305 1.000504 0.000898)))
+  (should (color-tests--approx-equal (color-oklab-to-xyz 0.153 -1.415 -0.449) '(0.000590 0.000057 1.001650))))
+
+(ert-deftest color-tests-xyz-to-oklab ()
+  (should (color-tests--approx-equal (color-xyz-to-oklab 0 0 0) '(0.0 0.0 0.0)))
+  (should (color-tests--approx-equal (color-xyz-to-oklab 0.95 1.0 1.089)
+                                     '(0.999969 -0.000258 -0.000115)))
+  (should (color-tests--approx-equal (color-xyz-to-oklab 1.0 0.0 0.0)
+                                     '(0.449932 1.235710 -0.019028)))
+  (should (color-tests--approx-equal (color-xyz-to-oklab 0.0 1.0 0.0)
+                                     '(0.921817 -0.671238 0.263324)))
+  (should (color-tests--approx-equal (color-xyz-to-oklab 0.0 0.0 1.0)
+                                     '(0.152603 -1.414997 -0.448927))))
+
+(ert-deftest color-tests-srgb-to-oklab ()
+  (should (equal (color-srgb-to-oklab 0 0 0) '(0.0 0.0 0.0)))
+  (should
+   (color-tests--approx-equal (color-srgb-to-oklab 0 0 1) '(0.451978 -0.032430 -0.311611)))
+  (should
+   (color-tests--approx-equal (color-srgb-to-oklab 0.1 0.2 0.3) '(0.313828 -0.019091 -0.052561))))
+
+(ert-deftest color-tests-oklab-to-srgb ()
+  (should (equal (color-oklab-to-srgb 0 0 0) '(0.0 0.0 0.0)))
+  (should
+   (color-tests--approx-equal (color-oklab-to-srgb 0.451978 -0.032430 -0.311611) '(0.0 0.0 1.0)))
+  (should
+   (color-tests--approx-equal (color-oklab-to-srgb 0.313828 -0.019091 -0.052561) '(0.1 0.2 0.3))))
+
 (provide 'color-tests)
 ;;; color-tests.el ends here