branch: externals/compat
commit 8d896bf8f7542b14480c005e8ed5e87e06a506fc
Author: Daniel Mendler <m...@daniel-mendler.de>
Commit: Daniel Mendler <m...@daniel-mendler.de>
compat-30: Add oklab color functions
Co-authored-by: Elijah Gabe Pérez <eg642...@gmail.com>
---
NEWS.org | 4 ++++
compat-30.el | 44 ++++++++++++++++++++++++++++++++++++++++++++
compat-tests.el | 40 ++++++++++++++++++++++++++++++++++++++++
compat.texi | 24 ++++++++++++++++++++++++
4 files changed, 112 insertions(+)
diff --git a/NEWS.org b/NEWS.org
index 5a5832f5c8..34c30818e9 100644
--- a/NEWS.org
+++ b/NEWS.org
@@ -2,6 +2,10 @@
#+link: compat-gh https://github.com/emacs-compat/compat/issues/
#+options: toc:nil num:nil author:nil
+* Development
+
+- compat-30: Add oklab color functions.
+
* Release of "Compat" Version 30.0.2.0
- compat-30: Rename =trusted-files= to =trusted-content=.
diff --git a/compat-30.el b/compat-30.el
index cb6e44249d..2decb93711 100644
--- a/compat-30.el
+++ b/compat-30.el
@@ -215,6 +215,50 @@ details."
(funcall completion-lazy-hilit-fn (copy-sequence str))
str))
+;;;; Defined in color.el
+
+(compat-defun color-oklab-to-xyz (l a b) ;; <compat-tests:color-oklab-to-xyz>
+ "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."
+ :feature color
+ (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)))))
+
+(compat-defun color-xyz-to-oklab (x y z) ;; <compat-tests:color-xyz-to-oklab>
+ "Convert the CIE XYZ color represented by X Y Z to Oklab."
+ :feature color
+ (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))))))
+
+(compat-defun color-oklab-to-srgb (l a b) ;; <compat-tests:color-oklab-to-srgb>
+ "Convert the Oklab color represented by L A B to sRGB."
+ :feature color
+ (apply #'color-xyz-to-srgb (color-oklab-to-xyz l a b)))
+
+(compat-defun color-srgb-to-oklab (r g b) ;; <compat-tests:color-srgb-to-oklab>
+ "Convert the sRGB color R G B to Oklab."
+ :feature color
+ (apply #'color-xyz-to-oklab (color-srgb-to-xyz r g b)))
+
;;;; Defined in subr.el
(compat-defmacro static-if (condition then-form &rest else-forms) ;;
<compat-tests:static-if>
diff --git a/compat-tests.el b/compat-tests.el
index 223d0dde69..baba1c296a 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -56,6 +56,7 @@
(require 'time-date)
(require 'image)
(require 'text-property-search nil t)
+(require 'color)
;; Setup tramp mock
(require 'tramp)
@@ -2681,6 +2682,45 @@
(should-not (color-values-from-color-spec "rgbi : 0/0/0"))
(should-not (color-values-from-color-spec "rgbi:0/0.5/10")))
+(defun compat--color-approx-equal (color1 color2)
+ "Return t if COLOR1 and COLOR2 are approximately equal."
+ (seq-every-p
+ (lambda (x) (< (abs x) 0.00001))
+ (cl-mapcar #'- color1 color2)))
+
+(ert-deftest compat-color-oklab-to-xyz ()
+ (should (compat--color-approx-equal (compat-call color-oklab-to-xyz 0 0 0)
'(0.0 0.0 0.0)))
+ (should (compat--color-approx-equal (compat-call color-oklab-to-xyz 1.0 0.0
0.0)
+ '(0.95047005 1.0 1.0883001)))
+ (should (compat--color-approx-equal (compat-call color-oklab-to-xyz 0.450
1.236 -0.019) '(1.000604 -0.000008 -0.000038)))
+ (should (compat--color-approx-equal (compat-call color-oklab-to-xyz 0.922
-0.671 0.263) '(0.000305 1.000504 0.000898)))
+ (should (compat--color-approx-equal (compat-call color-oklab-to-xyz 0.153
-1.415 -0.449) '(0.000590 0.000057 1.001650))))
+
+(ert-deftest compat-color-xyz-to-oklab ()
+ (should (compat--color-approx-equal (compat-call color-xyz-to-oklab 0 0 0)
'(0.0 0.0 0.0)))
+ (should (compat--color-approx-equal (compat-call color-xyz-to-oklab 0.95 1.0
1.089)
+ '(0.999969 -0.000258 -0.000115)))
+ (should (compat--color-approx-equal (compat-call color-xyz-to-oklab 1.0 0.0
0.0)
+ '(0.449932 1.235710 -0.019028)))
+ (should (compat--color-approx-equal (compat-call color-xyz-to-oklab 0.0 1.0
0.0)
+ '(0.921817 -0.671238 0.263324)))
+ (should (compat--color-approx-equal (compat-call color-xyz-to-oklab 0.0 0.0
1.0)
+ '(0.152603 -1.414997 -0.448927))))
+
+(ert-deftest compat-color-srgb-to-oklab ()
+ (should (equal (compat-call color-srgb-to-oklab 0 0 0) '(0.0 0.0 0.0)))
+ (should
+ (compat--color-approx-equal (compat-call color-srgb-to-oklab 0 0 1)
'(0.451978 -0.032430 -0.311611)))
+ (should
+ (compat--color-approx-equal (compat-call color-srgb-to-oklab 0.1 0.2 0.3)
'(0.313828 -0.019091 -0.052561))))
+
+(ert-deftest compat-color-oklab-to-srgb ()
+ (should (equal (compat-call color-oklab-to-srgb 0 0 0) '(0.0 0.0 0.0)))
+ (should
+ (compat--color-approx-equal (compat-call color-oklab-to-srgb 0.451978
-0.032430 -0.311611) '(0.0 0.0 1.0)))
+ (should
+ (compat--color-approx-equal (compat-call color-oklab-to-srgb 0.313828
-0.019091 -0.052561) '(0.1 0.2 0.3))))
+
(ert-deftest compat-lookup-key ()
(let ((a-map (make-sparse-keymap))
(b-map (make-sparse-keymap)))
diff --git a/compat.texi b/compat.texi
index c9ed82e322..2e08c91fb5 100644
--- a/compat.texi
+++ b/compat.texi
@@ -3355,6 +3355,30 @@ Return non-nil if we trust the contents of the current
buffer. Here,
also @code{trusted-content}.
@end defun
+@c based on lisp/color.el
+@defun color-oklab-to-xyz l a b
+Convert the OkLab color represented by @var{l} @var{a} @var{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.
+@end defun
+
+@c based on lisp/color.el
+@defun color-xyz-to-oklab x y z
+Convert the CIE XYZ color represented by @var{x} @var{y} @var{z} to Oklab.
+@end defun
+
+@c based on lisp/color.el
+@defun color-oklab-to-srgb l a b
+Convert the Oklab color represented by @var{l} @var{a} @var{b} to sRGB.
+@end defun
+
+@c based on lisp/color.el
+@defun color-srgb-to-oklab r g b
+Convert the sRGB color @var{r} @var{g} @var{b} to Oklab.
+@end defun
+
@c copied from lispref/nonascii.texi
@defun char-to-name char
This function returns the Unicode name of @var{char}. It returns
