[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[PATCH] lcms2 (was Re: Emacs 26.1 release branch created)
From: |
Mark Oteiza |
Subject: |
[PATCH] lcms2 (was Re: Emacs 26.1 release branch created) |
Date: |
Fri, 29 Sep 2017 16:25:40 -0400 |
User-agent: |
NeoMutt/20170912-48-0df7d3-dirty |
On 16/09/17 at 05:58pm, Eli Zaretskii wrote:
> > Date: Sat, 16 Sep 2017 10:51:12 -0400
> > From: Mark Oteiza <address@hidden>
> > Cc: address@hidden
> >
> > > > I'm working on more utilities and tests for lcms.c, where should I
> > > > commit those?
> > >
> > > On emacs-26, I guess. How many more utilities do you envision?
> > > (Tests are okay to add to emacs-26 regardless.)
> >
> > Dividing the internals of lcms-cam02-ucs into C functions, and from that
> > making the Lisp functions:
> >
> > lcms-xyz->jch
> > lcms-jch->jab
> > lcms-jab->jch
> > lcms-jch->xyz
> >
> > and adding a Lisp variable `lcms-d65-xyz' as the default whitepoint for
> > all the functions in lcms.c that need one. That should be two commits
> > if I can get all the Windows build stuff correct.
>
> That can certainly go to emacs-26.
>
> > I plan to add more, but I can wait for an emacs-26 -> master merge and
> > continue to work on master.
>
> If you consider the feature fairly complete for a first release, then
> that's fine. Otherwise we could consider adding more of your code to
> emacs-26, unless you think the development will take a considerable
> time. In general, once the first pretest is out (which will be
> probably a week or 2 from now), no new features should be added.
Here is the patch I thought I would not get done.
>From 98a0ff92120f7c23f716dc98b381660004b37a8c Mon Sep 17 00:00:00 2001
From: Mark Oteiza <address@hidden>
Date: Tue, 26 Sep 2017 17:13:36 -0400
Subject: [PATCH] Add CAM02 JCh and CAM02-UCS J'a'b' conversions
* src/lcms.h: New file.
* src/lcms.c (rad2deg, parse_jch_list, parse_jab_list, xyz_to_jch):
(jch_to_xyz, jch_to_jab, jab_to_jch): New functions.
(lcms-jch->xyz, lcms-jch->xyz, lcms-jch->jab, lcms-jab->jch): New Lisp
functions.
(lcms-cam02-ucs): Refactor.
(syms_of_lcms2): Declare new functions.
* test/src/lcms-tests.el (lcms-roundtrip, lcms-ciecam02-gold):
(lcms-jmh->cam02-ucs-silver): New tests.
---
src/lcms.c | 291 +++++++++++++++++++++++++++++++++++++++++++------
src/lcms.h | 30 +++++
test/src/lcms-tests.el | 44 ++++++++
3 files changed, 332 insertions(+), 33 deletions(-)
create mode 100644 src/lcms.h
diff --git a/src/lcms.c b/src/lcms.c
index a5e527911e..24b4f22ed1 100644
--- a/src/lcms.c
+++ b/src/lcms.c
@@ -24,6 +24,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <math.h>
#include "lisp.h"
+#include "lcms.h"
#ifdef WINDOWSNT
# include <windows.h>
@@ -145,6 +146,12 @@ deg2rad (double degrees)
return M_PI * degrees / 180.0;
}
+static double
+rad2deg (double radians)
+{
+ return 180.0 * radians / M_PI;
+}
+
static cmsCIEXYZ illuminant_d65 = { .X = 95.0455, .Y = 100.0, .Z = 108.8753 };
static void
@@ -180,6 +187,46 @@ parse_xyz_list (Lisp_Object xyz_list, cmsCIEXYZ *color)
return true;
}
+static bool
+parse_jch_list (Lisp_Object jch_list, cmsJCh *color)
+{
+#define PARSE_JCH_LIST_FIELD(field) \
+ if (CONSP (jch_list) && NUMBERP (XCAR (jch_list))) \
+ { \
+ color->field = XFLOATINT (XCAR (jch_list)); \
+ jch_list = XCDR (jch_list); \
+ } \
+ else \
+ return false;
+
+ PARSE_JCH_LIST_FIELD (J);
+ PARSE_JCH_LIST_FIELD (C);
+ PARSE_JCH_LIST_FIELD (h);
+
+ if (! NILP (jch_list))
+ return false;
+ return true;
+}
+
+static bool
+parse_jab_list (Lisp_Object jab_list, lcmsJab_t *color)
+{
+#define PARSE_JAB_LIST_FIELD(field) \
+ if (CONSP (jab_list) && NUMBERP (XCAR (jab_list))) \
+ { \
+ color->field = XFLOATINT (XCAR (jab_list)); \
+ jab_list = XCDR (jab_list); \
+ } \
+ else \
+ return false;
+
+ PARSE_JAB_LIST_FIELD (J);
+ PARSE_JAB_LIST_FIELD (a);
+ PARSE_JAB_LIST_FIELD (b);
+
+ return true;
+}
+
static bool
parse_viewing_conditions (Lisp_Object view, const cmsCIEXYZ *wp,
cmsViewingConditions *vc)
@@ -216,6 +263,204 @@ parse_viewing_conditions (Lisp_Object view, const
cmsCIEXYZ *wp,
return true;
}
+static void
+xyz_to_jch (const cmsCIEXYZ *xyz, cmsJCh *jch, const cmsViewingConditions *vc)
+{
+ cmsHANDLE h;
+
+ h = cmsCIECAM02Init (0, vc);
+ cmsCIECAM02Forward (h, xyz, jch);
+ cmsCIECAM02Done (h);
+}
+
+static void
+jch_to_xyz (const cmsJCh *jch, cmsCIEXYZ *xyz, const cmsViewingConditions *vc)
+{
+ cmsHANDLE h;
+
+ h = cmsCIECAM02Init (0, vc);
+ cmsCIECAM02Reverse (h, jch, xyz);
+ cmsCIECAM02Done (h);
+}
+
+static void
+jch_to_jab (const cmsJCh *jch, lcmsJab_t *jab, double FL, double c1, double c2)
+{
+ double Mp = 43.86 * log (1.0 + c2 * (jch->C * sqrt (sqrt (FL))));
+ jab->J = 1.7 * jch->J / (1.0 + (c1 * jch->J));
+ jab->a = Mp * cos (deg2rad (jch->h));
+ jab->b = Mp * sin (deg2rad (jch->h));
+}
+
+static void
+jab_to_jch (const lcmsJab_t *jab, cmsJCh *jch, double FL, double c1, double c2)
+{
+ jch->J = jab->J / (1.0 + c1 * (100.0 - jab->J));
+ jch->h = atan2 (jab->b, jab->a);
+ double Mp = sqrt (jab->a * jab->a + jab->b * jab->b);
+ jch->h = rad2deg (jch->h);
+ if (jch->h < 0.0)
+ jch->h += 360.0;
+ jch->C = (exp (c2 * Mp) - 1) / (c2 * sqrt (sqrt (FL)));
+}
+
+DEFUN ("lcms-xyz->jch", Flcms_xyz_to_jch, Slcms_xyz_to_jch, 1, 3, 0,
+ doc: /* Convert CIE CAM02 JCh to CIE XYZ.
+COLOR is a list (X Y Z), with Y scaled about unity.
+Optional arguments WHITEPOINT and VIEW are the same as in `lcms-cam02-ucs',
+which see. */)
+ (Lisp_Object color, Lisp_Object whitepoint, Lisp_Object view)
+{
+ cmsViewingConditions vc;
+ cmsJCh jch;
+ cmsCIEXYZ xyz, xyzw;
+
+#ifdef WINDOWSNT
+ if (!lcms_initialized)
+ lcms_initialized = init_lcms_functions ();
+ if (!lcms_initialized)
+ {
+ message1 ("lcms2 library not found");
+ return Qnil;
+ }
+#endif
+
+ if (!(CONSP (color) && parse_xyz_list (color, &xyz)))
+ signal_error ("Invalid color", color);
+ if (NILP (whitepoint))
+ xyzw = illuminant_d65;
+ else if (!(CONSP (whitepoint) && parse_xyz_list (whitepoint, &xyzw)))
+ signal_error ("Invalid white point", whitepoint);
+ if (NILP (view))
+ default_viewing_conditions (&xyzw, &vc);
+ else if (!(CONSP (view) && parse_viewing_conditions (view, &xyzw, &vc)))
+ signal_error ("Invalid viewing conditions", view);
+
+ xyz_to_jch(&xyz, &jch, &vc);
+ return list3 (make_float (jch.J), make_float (jch.C), make_float (jch.h));
+}
+
+DEFUN ("lcms-jch->xyz", Flcms_jch_to_xyz, Slcms_jch_to_xyz, 1, 3, 0,
+ doc: /* Convert CIE XYZ to CIE CAM02 JCh.
+COLOR is a list (J C h), where lightness of white is equal to 100, and hue
+is given in degrees.
+Optional arguments WHITEPOINT and VIEW are the same as in `lcms-cam02-ucs',
+which see. */)
+ (Lisp_Object color, Lisp_Object whitepoint, Lisp_Object view)
+{
+ cmsViewingConditions vc;
+ cmsJCh jch;
+ cmsCIEXYZ xyz, xyzw;
+
+#ifdef WINDOWSNT
+ if (!lcms_initialized)
+ lcms_initialized = init_lcms_functions ();
+ if (!lcms_initialized)
+ {
+ message1 ("lcms2 library not found");
+ return Qnil;
+ }
+#endif
+
+ if (!(CONSP (color) && parse_jch_list (color, &jch)))
+ signal_error ("Invalid color", color);
+ if (NILP (whitepoint))
+ xyzw = illuminant_d65;
+ else if (!(CONSP (whitepoint) && parse_xyz_list (whitepoint, &xyzw)))
+ signal_error ("Invalid white point", whitepoint);
+ if (NILP (view))
+ default_viewing_conditions (&xyzw, &vc);
+ else if (!(CONSP (view) && parse_viewing_conditions (view, &xyzw, &vc)))
+ signal_error ("Invalid viewing conditions", view);
+
+ jch_to_xyz(&jch, &xyz, &vc);
+ return list3 (make_float (xyz.X / 100.0),
+ make_float (xyz.Y / 100.0),
+ make_float (xyz.Z / 100.0));
+}
+
+DEFUN ("lcms-jch->jab", Flcms_jch_to_jab, Slcms_jch_to_jab, 1, 3, 0,
+ doc: /* Convert CIE CAM02 JCh to CAM02-UCS J'a'b'.
+COLOR is a list (J C h) as described in `lcms-jch->xyz', which see.
+Optional arguments WHITEPOINT and VIEW are the same as in `lcms-cam02-ucs',
+which see. */)
+ (Lisp_Object color, Lisp_Object whitepoint, Lisp_Object view)
+{
+ cmsViewingConditions vc;
+ lcmsJab_t jab;
+ cmsJCh jch;
+ cmsCIEXYZ xyzw;
+ double FL, k, k4;
+
+#ifdef WINDOWSNT
+ if (!lcms_initialized)
+ lcms_initialized = init_lcms_functions ();
+ if (!lcms_initialized)
+ {
+ message1 ("lcms2 library not found");
+ return Qnil;
+ }
+#endif
+
+ if (!(CONSP (color) && parse_jch_list (color, &jch)))
+ signal_error ("Invalid color", color);
+ if (NILP (whitepoint))
+ xyzw = illuminant_d65;
+ else if (!(CONSP (whitepoint) && parse_xyz_list (whitepoint, &xyzw)))
+ signal_error ("Invalid white point", whitepoint);
+ if (NILP (view))
+ default_viewing_conditions (&xyzw, &vc);
+ else if (!(CONSP (view) && parse_viewing_conditions (view, &xyzw, &vc)))
+ signal_error ("Invalid viewing conditions", view);
+
+ k = 1.0 / (1.0 + (5.0 * vc.La));
+ k4 = k * k * k * k;
+ FL = vc.La * k4 + 0.1 * (1 - k4) * (1 - k4) * cbrt (5.0 * vc.La);
+ jch_to_jab (&jch, &jab, FL, 0.007, 0.0228);
+ return list3 (make_float (jab.J), make_float (jab.a), make_float (jab.b));
+}
+
+DEFUN ("lcms-jab->jch", Flcms_jab_to_jch, Slcms_jab_to_jch, 1, 3, 0,
+ doc: /* Convert CAM02-UCS J'a'b' to CIE CAM02 JCh.
+COLOR is a list (J' a' b'), where white corresponds to lightness J equal to
100.
+Optional arguments WHITEPOINT and VIEW are the same as in `lcms-cam02-ucs',
+which see. */)
+ (Lisp_Object color, Lisp_Object whitepoint, Lisp_Object view)
+{
+ cmsViewingConditions vc;
+ cmsJCh jch;
+ lcmsJab_t jab;
+ cmsCIEXYZ xyzw;
+ double FL, k, k4;
+
+#ifdef WINDOWSNT
+ if (!lcms_initialized)
+ lcms_initialized = init_lcms_functions ();
+ if (!lcms_initialized)
+ {
+ message1 ("lcms2 library not found");
+ return Qnil;
+ }
+#endif
+
+ if (!(CONSP (color) && parse_jab_list (color, &jab)))
+ signal_error ("Invalid color", color);
+ if (NILP (whitepoint))
+ xyzw = illuminant_d65;
+ else if (!(CONSP (whitepoint) && parse_xyz_list (whitepoint, &xyzw)))
+ signal_error ("Invalid white point", whitepoint);
+ if (NILP (view))
+ default_viewing_conditions (&xyzw, &vc);
+ else if (!(CONSP (view) && parse_viewing_conditions (view, &xyzw, &vc)))
+ signal_error ("Invalid viewing conditions", view);
+
+ k = 1.0 / (1.0 + (5.0 * vc.La));
+ k4 = k * k * k * k;
+ FL = vc.La * k4 + 0.1 * (1 - k4) * (1 - k4) * cbrt (5.0 * vc.La);
+ jab_to_jch (&jab, &jch, FL, 0.007, 0.0228);
+ return list3 (make_float (jch.J), make_float (jch.C), make_float (jch.h));
+}
+
/* References:
Li, Luo et al. "The CRI-CAM02UCS colour rendering index." COLOR research
and application, 37 No.3, 2012.
@@ -239,10 +484,9 @@ The default viewing conditions are (20 100 1 1). */)
{
cmsViewingConditions vc;
cmsJCh jch1, jch2;
- cmsHANDLE h1, h2;
cmsCIEXYZ xyz1, xyz2, xyzw;
- double Jp1, ap1, bp1, Jp2, ap2, bp2;
- double Mp1, Mp2, FL, k, k4;
+ lcmsJab_t jab1, jab2;
+ double FL, k, k4;
#ifdef WINDOWSNT
if (!lcms_initialized)
@@ -267,41 +511,18 @@ The default viewing conditions are (20 100 1 1). */)
else if (!(CONSP (view) && parse_viewing_conditions (view, &xyzw, &vc)))
signal_error ("Invalid view conditions", view);
- h1 = cmsCIECAM02Init (0, &vc);
- h2 = cmsCIECAM02Init (0, &vc);
- cmsCIECAM02Forward (h1, &xyz1, &jch1);
- cmsCIECAM02Forward (h2, &xyz2, &jch2);
- cmsCIECAM02Done (h1);
- cmsCIECAM02Done (h2);
+ xyz_to_jch (&xyz1, &jch1, &vc);
+ xyz_to_jch (&xyz2, &jch2, &vc);
- /* Now have colors in JCh, need to calculate J'a'b'
-
- M = C * F_L^0.25
- J' = 1.7 J / (1 + 0.007 J)
- M' = 43.86 ln(1 + 0.0228 M)
- a' = M' cos(h)
- b' = M' sin(h)
-
- where
-
- F_L = 0.2 k^4 (5 L_A) + 0.1 (1 - k^4)^2 (5 L_A)^(1/3),
- k = 1/(5 L_A + 1)
- */
k = 1.0 / (1.0 + (5.0 * vc.La));
k4 = k * k * k * k;
FL = vc.La * k4 + 0.1 * (1 - k4) * (1 - k4) * cbrt (5.0 * vc.La);
- Mp1 = 43.86 * log (1.0 + 0.0228 * (jch1.C * sqrt (sqrt (FL))));
- Mp2 = 43.86 * log (1.0 + 0.0228 * (jch2.C * sqrt (sqrt (FL))));
- Jp1 = 1.7 * jch1.J / (1.0 + (0.007 * jch1.J));
- Jp2 = 1.7 * jch2.J / (1.0 + (0.007 * jch2.J));
- ap1 = Mp1 * cos (deg2rad (jch1.h));
- ap2 = Mp2 * cos (deg2rad (jch2.h));
- bp1 = Mp1 * sin (deg2rad (jch1.h));
- bp2 = Mp2 * sin (deg2rad (jch2.h));
+ jch_to_jab (&jch1, &jab1, FL, 0.007, 0.0228);
+ jch_to_jab (&jch2, &jab2, FL, 0.007, 0.0228);
- return make_float (sqrt ((Jp2 - Jp1) * (Jp2 - Jp1) +
- (ap2 - ap1) * (ap2 - ap1) +
- (bp2 - bp1) * (bp2 - bp1)));
+ return make_float (sqrt ((jab2.J - jab1.J) * (jab2.J - jab1.J) +
+ (jab2.a - jab1.a) * (jab2.a - jab1.a) +
+ (jab2.b - jab1.b) * (jab2.b - jab1.b)));
}
DEFUN ("lcms-temp->white-point", Flcms_temp_to_white_point,
Slcms_temp_to_white_point, 1, 1, 0,
@@ -359,6 +580,10 @@ void
syms_of_lcms2 (void)
{
defsubr (&Slcms_cie_de2000);
+ defsubr (&Slcms_xyz_to_jch);
+ defsubr (&Slcms_jch_to_xyz);
+ defsubr (&Slcms_jch_to_jab);
+ defsubr (&Slcms_jab_to_jch);
defsubr (&Slcms_cam02_ucs);
defsubr (&Slcms2_available_p);
defsubr (&Slcms_temp_to_white_point);
diff --git a/src/lcms.h b/src/lcms.h
new file mode 100644
index 0000000000..6080de06ca
--- /dev/null
+++ b/src/lcms.h
@@ -0,0 +1,30 @@
+/* Definitions for data structures and routines for the
+ interface to Little CMS
+ Copyright (C) 2017 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
+
+#ifndef _LCMS_H
+#define _LCMS_H 1
+
+typedef struct
+{
+ double J;
+ double a;
+ double b;
+} lcmsJab_t;
+
+#endif /* lcms.h */
diff --git a/test/src/lcms-tests.el b/test/src/lcms-tests.el
index d6d1d16b9a..cc324af68b 100644
--- a/test/src/lcms-tests.el
+++ b/test/src/lcms-tests.el
@@ -94,6 +94,38 @@ lcms-rgb255->xyz
(apply #'color-xyz-to-xyy (lcms-temp->white-point 7504))
'(0.29902 0.31485 1.0))))
+(ert-deftest lcms-roundtrip ()
+ "Test accuracy of converting to and from different color spaces"
+ (skip-unless (featurep 'lcms2))
+ (should
+ (let ((color '(.5 .3 .7)))
+ (lcms-triple-approx-p (lcms-jch->xyz (lcms-xyz->jch color))
+ color
+ 0.0001)))
+ (should
+ (let ((color '(.8 -.2 .2)))
+ (lcms-triple-approx-p (lcms-jch->jab (lcms-jab->jch color))
+ color
+ 0.0001))))
+
+(ert-deftest lcms-ciecam02-gold ()
+ "Test CIE CAM02 JCh gold values"
+ (skip-unless (featurep 'lcms2))
+ (should
+ (lcms-triple-approx-p
+ (lcms-xyz->jch '(0.1931 0.2393 0.1014)
+ '(0.9888 0.900 0.3203)
+ '(18 200 1 1.0))
+ '(48.0314 38.7789 191.0452)
+ 0.02))
+ (should
+ (lcms-triple-approx-p
+ (lcms-xyz->jch '(0.1931 0.2393 0.1014)
+ '(0.9888 0.90 0.3203)
+ '(18 20 1 1.0))
+ '(47.6856 36.0527 185.3445)
+ 0.09)))
+
(ert-deftest lcms-dE-cam02-ucs-silver ()
"Test CRI-CAM02-UCS deltaE metric values from colorspacious."
(skip-unless (featurep 'lcms2))
@@ -114,4 +146,16 @@ lcms-rgb255->xyz
8.503323264883667
0.04)))
+(ert-deftest lcms-jmh->cam02-ucs-silver ()
+ "Compare JCh conversion to CAM02-UCS to values from colorspacious."
+ (skip-unless (featurep 'lcms2))
+ (should
+ (lcms-triple-approx-p (lcms-jch->jab '(50 20 10))
+ '(62.96296296 16.22742674 2.86133316)
+ 0.05))
+ (should
+ (lcms-triple-approx-p (lcms-jch->jab '(10 60 100))
+ '(15.88785047 -6.56546789 37.23461867)
+ 0.04)))
+
;;; lcms-tests.el ends here
--
2.14.2
- Re: Emacs 26.1 release branch created, (continued)
- Re: Emacs 26.1 release branch created, Eli Zaretskii, 2017/09/16
- Re: Emacs 26.1 release branch created, Mark Oteiza, 2017/09/16
- Re: Emacs 26.1 release branch created, Eli Zaretskii, 2017/09/16
- Re: Emacs 26.1 release branch created, Mark Oteiza, 2017/09/16
- Re: Emacs 26.1 release branch created, Eli Zaretskii, 2017/09/16
- Re: Emacs 26.1 release branch created, Mark Oteiza, 2017/09/22
- Re: Emacs 26.1 release branch created, Eli Zaretskii, 2017/09/22
- Re: Emacs 26.1 release branch created, Mark Oteiza, 2017/09/22
- Re: Emacs 26.1 release branch created, Eli Zaretskii, 2017/09/22
- Re: Emacs 26.1 release branch created, Mark Oteiza, 2017/09/22
- [PATCH] lcms2 (was Re: Emacs 26.1 release branch created),
Mark Oteiza <=
- Re: [PATCH] lcms2 (was Re: Emacs 26.1 release branch created), Eli Zaretskii, 2017/09/30
Re: Emacs 26.1 release branch created, Alan Mackenzie, 2017/09/16
Re: Emacs 26.1 release branch created, Rasmus, 2017/09/16
- Re: Emacs 26.1 release branch created, Eli Zaretskii, 2017/09/16
- Re: Emacs 26.1 release branch created, Rasmus, 2017/09/18
- Re: Emacs 26.1 release branch created, Rasmus, 2017/09/18
- Re: Emacs 26.1 release branch created, Kaushal Modi, 2017/09/20
- Re: Emacs 26.1 release branch created, Nicolas Petton, 2017/09/20
- Re: Emacs 26.1 release branch created, Kaushal Modi, 2017/09/20
- Re: Emacs 26.1 release branch created, Rasmus, 2017/09/20