GNU bug report logs - #28400
26.0.50; lcms2 bindings

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 28400 in the body.
You can then email your comments to 28400 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Mark Oteiza <mvoteiza <at> udel.edu>
To: bug-gnu-emacs <at> gnu.org
Subject: 26.0.50; lcms2 bindings
Date: Sat, 09 Sep 2017 11:50:34 -0400

[Message part 1 (text/plain, inline)]

Wishlist.

Hi,

Some time ago I wrote some integration with lcms2 in the interest of
replacing tty-color-approximate, color-distance, etc. with superior
(more perceptually uniform) color metrics.  This would presumably
improve Emacs' color picking on smaller color palettes (e.g. 256 color
term) and potentially provide access to many useful color-related
functions in Lisp---not to discount color.el.

I am not sure how this might be added--perhaps in its own .c file and
exposing a feature?

Attached is a patch splicing lcms2 CIE DE2000 into color-distance.
I don't know what x_alloc_nearest_color_1 does but I apparently patched
that as well.

Also attached is a small module with CIE DE2000 and CAM02-UCS color
distance functions.

[lcms2.patch (text/x-diff, attachment)]

[lcms2.c (text/x-csrc, attachment)]

Message #8 received at 28400 <at> debbugs.gnu.org (full text, mbox):

From: Eli Zaretskii <eliz <at> gnu.org>
To: Mark Oteiza <mvoteiza <at> udel.edu>
Cc: 28400 <at> debbugs.gnu.org
Subject: Re: bug#28400: 26.0.50; lcms2 bindings
Date: Sat, 09 Sep 2017 20:37:29 +0300

> From: Mark Oteiza <mvoteiza <at> udel.edu>
> Date: Sat, 09 Sep 2017 11:50:34 -0400
> 
> Some time ago I wrote some integration with lcms2 in the interest of
> replacing tty-color-approximate, color-distance, etc. with superior
> (more perceptually uniform) color metrics.  This would presumably
> improve Emacs' color picking on smaller color palettes (e.g. 256 color
> term) and potentially provide access to many useful color-related
> functions in Lisp---not to discount color.el.

Is it really so much better than what we have now to justify requiring
yet another library to build Emacs?  If it is, could you tell what are
the main advantages, or point to where those advantages are described?

Btw, 256 colors is not "small" by Emacs standards, because our color
approximation should (and does) work in 8-color terminals as well.

Thanks.

Message #11 received at 28400 <at> debbugs.gnu.org (full text, mbox):

From: Mark Oteiza <mvoteiza <at> udel.edu>
To: Eli Zaretskii <eliz <at> gnu.org>
Cc: 28400 <at> debbugs.gnu.org
Subject: Re: bug#28400: 26.0.50; lcms2 bindings
Date: Sun, 10 Sep 2017 18:04:22 -0400

On 09/09/17 at 08:37pm, Eli Zaretskii wrote:
>> From: Mark Oteiza <mvoteiza <at> udel.edu>
>> Date: Sat, 09 Sep 2017 11:50:34 -0400
>>
>> Some time ago I wrote some integration with lcms2 in the interest of
>> replacing tty-color-approximate, color-distance, etc. with superior
>> (more perceptually uniform) color metrics.  This would presumably
>> improve Emacs' color picking on smaller color palettes (e.g. 256 color
>> term) and potentially provide access to many useful color-related
>> functions in Lisp---not to discount color.el.
>
>Is it really so much better than what we have now to justify requiring
>yet another library to build Emacs?  If it is, could you tell what are
>the main advantages, or point to where those advantages are described?

It was just much easier for me to hack existing code than figure out adding
a new file and the configure.ac business.  It would be much more
sensible to offer it as an optional feature and expose color metrics as
optional arguments, e.g.

 (color-distance COLOR1 COLOR2 &optional FRAME METRIC)

where METRIC accepts two colors and returns a number.

>Btw, 256 colors is not "small" by Emacs standards, because our color
>approximation should (and does) work in 8-color terminals as well.

Yes, I should have used a different word than "small".  Approximations
for smaller palettes is easier because the differences between
individual members of the palette are much bigger.  The 256 color
palette (and larger) has many colors much closer to one another, and
calculating perceptual differences between colors that are close
requires a more sophisticated model.

For instance, take CIEDE2000
https://en.wikipedia.org/wiki/Color_difference#CIEDE2000
and compare it to the newer CAM02-UCS
http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.844.5693&rep=rep1&type=pdf
IIRC CAM02 is the de facto model for CMS.  I'm certain Windows uses it
for its CMS.

I like this talk about Matplotlib's new color map.  It explains the
differences between color spaces among other things
https://www.youtube.com/watch?v=xAoljeRJ3lU

Message #14 received at 28400 <at> debbugs.gnu.org (full text, mbox):

From: Eli Zaretskii <eliz <at> gnu.org>
To: Mark Oteiza <mvoteiza <at> udel.edu>
Cc: 28400 <at> debbugs.gnu.org
Subject: Re: bug#28400: 26.0.50; lcms2 bindings
Date: Mon, 11 Sep 2017 18:01:45 +0300

> Date: Sun, 10 Sep 2017 18:04:22 -0400
> From: Mark Oteiza <mvoteiza <at> udel.edu>
> Cc: 28400 <at> debbugs.gnu.org
> 
> >Is it really so much better than what we have now to justify requiring
> >yet another library to build Emacs?  If it is, could you tell what are
> >the main advantages, or point to where those advantages are described?
> 
> It was just much easier for me to hack existing code than figure out adding
> a new file and the configure.ac business.  It would be much more
> sensible to offer it as an optional feature and expose color metrics as
> optional arguments, e.g.
> 
>   (color-distance COLOR1 COLOR2 &optional FRAME METRIC)
> 
> where METRIC accepts two colors and returns a number.

Oh, I see.  But in that case, I think adding a new file and the
configure.ac business is actually quite easy.  Search configure.ac for
"libz", and you will see a typical example: it involves adding a new
"--with-FOO" option to configure, and then some pretty boilerplate
code to test whether some tell-tale header file is present, and tweak
the compilation/linking flags accordingly.  The new file then should
have all of its body wrapped in "#ifdef HAVE_FOO..#endif", with only
config.h outside of that condition and maybe some simple predicate to
test for the feature existence; see xml.c for a good example.  Then
add that new file to src/Makefile.in, and you are pretty much done.

As for color-distance, did you intend to replace or provide a better
alternative to similar functions in color.el?

> >Btw, 256 colors is not "small" by Emacs standards, because our color
> >approximation should (and does) work in 8-color terminals as well.
> 
> Yes, I should have used a different word than "small".  Approximations
> for smaller palettes is easier because the differences between
> individual members of the palette are much bigger.  The 256 color
> palette (and larger) has many colors much closer to one another, and
> calculating perceptual differences between colors that are close
> requires a more sophisticated model.

So you are saying that tty-colors.el is too simplistic for ncolors
around 256?  If so, perhaps this optional feature could provide
compatible alternatives to that?

Thanks.

Message #17 received at 28400 <at> debbugs.gnu.org (full text, mbox):

From: Mark Oteiza <mvoteiza <at> udel.edu>
To: Eli Zaretskii <eliz <at> gnu.org>
Cc: 28400 <at> debbugs.gnu.org
Subject: Re: bug#28400: 26.0.50; lcms2 bindings
Date: Mon, 11 Sep 2017 11:25:20 -0400

On 11/09/17 at 06:01pm, Eli Zaretskii wrote:
> > Date: Sun, 10 Sep 2017 18:04:22 -0400
> > From: Mark Oteiza <mvoteiza <at> udel.edu>
> > Cc: 28400 <at> debbugs.gnu.org
> > 
> > >Is it really so much better than what we have now to justify requiring
> > >yet another library to build Emacs?  If it is, could you tell what are
> > >the main advantages, or point to where those advantages are described?
> > 
> > It was just much easier for me to hack existing code than figure out adding
> > a new file and the configure.ac business.  It would be much more
> > sensible to offer it as an optional feature and expose color metrics as
> > optional arguments, e.g.
> > 
> >   (color-distance COLOR1 COLOR2 &optional FRAME METRIC)
> > 
> > where METRIC accepts two colors and returns a number.
> 
> Oh, I see.  But in that case, I think adding a new file and the
> configure.ac business is actually quite easy.  Search configure.ac for
> "libz", and you will see a typical example: it involves adding a new
> "--with-FOO" option to configure, and then some pretty boilerplate
> code to test whether some tell-tale header file is present, and tweak
> the compilation/linking flags accordingly.  The new file then should
> have all of its body wrapped in "#ifdef HAVE_FOO..#endif", with only
> config.h outside of that condition and maybe some simple predicate to
> test for the feature existence; see xml.c for a good example.  Then
> add that new file to src/Makefile.in, and you are pretty much done.

Thanks, I'll attempt that.

> As for color-distance, did you intend to replace or provide a better
> alternative to similar functions in color.el?

That is a good question.  I've thought about it, but don't have a good
answer.  lcms2 could certainly replace some of the things in color.el,
but if it's an optional feature I guess there are a number of ways to
handle it.  If we include lcms2.c providing its own 'cms or 'lcms2
feature, I guess featurep'ing things wouldn't be so bad.

> > >Btw, 256 colors is not "small" by Emacs standards, because our color
> > >approximation should (and does) work in 8-color terminals as well.
> > 
> > Yes, I should have used a different word than "small".  Approximations
> > for smaller palettes is easier because the differences between
> > individual members of the palette are much bigger.  The 256 color
> > palette (and larger) has many colors much closer to one another, and
> > calculating perceptual differences between colors that are close
> > requires a more sophisticated model.
> 
> So you are saying that tty-colors.el is too simplistic for ncolors
> around 256?

It will get some interesting results. For instance, asking Emacs for
#3d3535 (dark, slightly reddish grey) in a 256 color term will yield
#5f005f (color-53, a strong purple) instead of color-235 or color-236
(dark greys).  It does a good job overall, so I don't suggest changing
it.

> If so, perhaps this optional feature could provide
> compatible alternatives to that?

Sure, like the example above for color-distance, tty-colors-approximate
could expose an extra optional argument and/or respond to a variable.

Message #20 received at 28400 <at> debbugs.gnu.org (full text, mbox):

From: Eli Zaretskii <eliz <at> gnu.org>
To: Mark Oteiza <mvoteiza <at> udel.edu>
Cc: 28400 <at> debbugs.gnu.org
Subject: Re: bug#28400: 26.0.50; lcms2 bindings
Date: Mon, 11 Sep 2017 18:35:05 +0300

> Date: Mon, 11 Sep 2017 11:25:20 -0400
> From: Mark Oteiza <mvoteiza <at> udel.edu>
> Cc: 28400 <at> debbugs.gnu.org
> 
> > As for color-distance, did you intend to replace or provide a better
> > alternative to similar functions in color.el?
> 
> That is a good question.  I've thought about it, but don't have a good
> answer.  lcms2 could certainly replace some of the things in color.el,
> but if it's an optional feature I guess there are a number of ways to
> handle it.  If we include lcms2.c providing its own 'cms or 'lcms2
> feature, I guess featurep'ing things wouldn't be so bad.

color.el could call lcms2 functions if they are available, and if not,
fall back on its own implementation.

> > If so, perhaps this optional feature could provide
> > compatible alternatives to that?
> 
> Sure, like the example above for color-distance, tty-colors-approximate
> could expose an extra optional argument and/or respond to a variable.

Sounds good, thanks.

Message #23 received at 28400 <at> debbugs.gnu.org (full text, mbox):

From: Mark Oteiza <mvoteiza <at> udel.edu>
To: Eli Zaretskii <eliz <at> gnu.org>
Cc: 28400 <at> debbugs.gnu.org
Subject: Re: bug#28400: 26.0.50; lcms2 bindings
Date: Mon, 11 Sep 2017 19:10:06 -0400

On 11/09/17 at 06:01pm, Eli Zaretskii wrote:
> > Date: Sun, 10 Sep 2017 18:04:22 -0400
> > From: Mark Oteiza <mvoteiza <at> udel.edu>
> > Cc: 28400 <at> debbugs.gnu.org
> > 
> > >Is it really so much better than what we have now to justify requiring
> > >yet another library to build Emacs?  If it is, could you tell what are
> > >the main advantages, or point to where those advantages are described?
> > 
> > It was just much easier for me to hack existing code than figure out adding
> > a new file and the configure.ac business.  It would be much more
> > sensible to offer it as an optional feature and expose color metrics as
> > optional arguments, e.g.
> > 
> >   (color-distance COLOR1 COLOR2 &optional FRAME METRIC)
> > 
> > where METRIC accepts two colors and returns a number.
> 
> Oh, I see.  But in that case, I think adding a new file and the
> configure.ac business is actually quite easy.

Humble beginnings attached.

 configure.ac    |  19 +++++++
 src/Makefile.in |   6 ++-
 src/emacs.c     |   4 ++
 src/lcms.c      | 157 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 src/lisp.h      |   5 ++
 5 files changed, 189 insertions(+), 2 deletions(-)

diff --git a/configure.ac b/configure.ac
index d294412dc4..df3931f938 100644
--- a/configure.ac
+++ b/configure.ac
@@ -3451,6 +3451,25 @@ AC_DEFUN
 fi
 AC_SUBST(LIBJPEG)
 
+HAVE_LCMS2=no
+LIBLCMS2=
+if test "${with_lcms2}" != "no"; then
+  OLIBS=$LIBS
+  AC_SEARCH_LIBS([cmsCreateTransform], [lcms2], [HAVE_LCMS2=yes])
+  LIBS=$OLIBS
+  case $ac_cv_search_cmsCreateTransform in
+    -*) LIBLCMS2=$ac_cv_search_cmsCreateTransform ;;
+  esac
+fi
+if test "${HAVE_LCMS2}" = "yes"; then
+  AC_DEFINE([HAVE_LCMS2], 1, [Define to 1 if you have the lcms2 library (-llcms2).])
+  ### ???
+  if test "${opsys}" = "mingw32"; then
+     LIBLCMS2=
+  fi
+fi
+AC_SUBST(LIBLCMS2)
+
 HAVE_ZLIB=no
 LIBZ=
 if test "${with_zlib}" != "no"; then
diff --git a/src/Makefile.in b/src/Makefile.in
index dde3f1d3fb..a98ad9c5eb 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -234,6 +234,8 @@ LIBXML2_CFLAGS =
 
 GETADDRINFO_A_LIBS = @GETADDRINFO_A_LIBS@
 
+LIBLCMS2 = @LIBLCMS2@
+
 LIBZ = @LIBZ@
 
 ## system-specific libs for dynamic modules, else empty
@@ -389,7 +391,7 @@ base_obj =
 	syntax.o $(UNEXEC_OBJ) bytecode.o \
 	process.o gnutls.o callproc.o \
 	region-cache.o sound.o atimer.o \
-	doprnt.o intervals.o textprop.o composite.o xml.o $(NOTIFY_OBJ) \
+	doprnt.o intervals.o textprop.o composite.o xml.o lcms.o $(NOTIFY_OBJ) \
 	$(XWIDGETS_OBJ) \
 	profiler.o decompress.o \
 	thread.o systhread.o \
@@ -490,7 +492,7 @@ LIBES =
    $(LIBXML2_LIBS) $(LIBGPM) $(LIBS_SYSTEM) $(CAIRO_LIBS) \
    $(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(SETTINGS_LIBS) $(LIBSELINUX_LIBS) \
    $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \
-   $(LIBGNUTLS_LIBS) $(LIB_PTHREAD) $(GETADDRINFO_A_LIBS) \
+   $(LIBGNUTLS_LIBS) $(LIB_PTHREAD) $(GETADDRINFO_A_LIBS) $(LIBLCMS2) \
    $(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) $(LIBSYSTEMD_LIBS)
 
 ## FORCE it so that admin/unidata can decide whether these files
diff --git a/src/emacs.c b/src/emacs.c
index 44f6285795..668711a5ab 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -1546,6 +1546,10 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
       syms_of_xml ();
 #endif
 
+#ifdef HAVE_LCMS2
+      syms_of_lcms2 ();
+#endif
+
 #ifdef HAVE_ZLIB
       syms_of_decompress ();
 #endif
diff --git a/src/lcms.c b/src/lcms.c
new file mode 100644
index 0000000000..560b262818
--- /dev/null
+++ b/src/lcms.c
@@ -0,0 +1,157 @@
+/* Interface to Little CMS
+   Copyright (C) 2017 Mark Oteiza <mvoteiza <at> udel.edu>
+
+This file is NOT 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 <http://www.gnu.org/licenses/>.  */
+
+#include <config.h>
+
+#ifdef HAVE_LCMS2
+
+#include <lcms2.h>
+#include <math.h>
+
+#include "lisp.h"
+
+static bool
+parse_lab_list (Lisp_Object lab_list, cmsCIELab *color)
+{
+#define PARSE_LAB_LIST_FIELD(field)					\
+  if (CONSP (lab_list) && NUMBERP (XCAR (lab_list)))			\
+    {									\
+      color->field = XFLOATINT (XCAR (lab_list));			\
+      lab_list = XCDR (lab_list);					\
+    }									\
+  else									\
+    return false;
+
+  PARSE_LAB_LIST_FIELD (L);
+  PARSE_LAB_LIST_FIELD (a);
+  PARSE_LAB_LIST_FIELD (b);
+
+  return true;
+}
+
+/* http://www.ece.rochester.edu/~gsharma/ciede2000/ciede2000noteCRNA.pdf> */
+
+DEFUN ("lcms-cie-de2000", Flcms_cie_de2000, Slcms_cie_de2000, 2, 2, 0,
+       doc: /* Compute CIEDE2000 metric distance between COLOR1 and COLOR2.
+Each color is a list of L*a*b* coordinates, where the L* channel ranges from
+0 to 100, and the a* and b* channels range from -128 to 128.
+Optional arguments KL, KC, KH are weighting parameters for lightness,
+chroma, and hue, respectively. */)
+  (Lisp_Object color1, Lisp_Object color2)
+{
+  cmsCIELab Lab1, Lab2;
+
+  if (!(CONSP (color1) && parse_lab_list (color1, &Lab1)))
+    signal_error ("Invalid color", color1);
+  if (!(CONSP (color2) && parse_lab_list (color2, &Lab2)))
+    signal_error ("Invalid color", color1);
+  return make_float (cmsCIE2000DeltaE (&Lab1, &Lab2, 1.0f, 1.0f, 1.0f));
+}
+
+/* FIXME: code duplication */
+
+static bool
+parse_xyz_list (Lisp_Object xyz_list, cmsCIEXYZ *color)
+{
+#define PARSE_XYZ_LIST_FIELD(field)					\
+  if (CONSP (xyz_list) && NUMBERP (XCAR (xyz_list)))			\
+    {									\
+      color->field = XFLOATINT (XCAR (xyz_list));			\
+      xyz_list = XCDR (xyz_list);					\
+    }									\
+  else									\
+    return false;
+
+  PARSE_XYZ_LIST_FIELD (X);
+  PARSE_XYZ_LIST_FIELD (Y);
+  PARSE_XYZ_LIST_FIELD (Z);
+
+  return true;
+}
+
+DEFUN ("lcms-cam02-ucs", Flcms-cam02-ucs, Slcms_cam02_ucs, 2, 2, 0,
+       doc: /* Compute CAM02-UCS metric distance between COLOR1 and COLOR2.
+Each color is a list of XYZ coordinates.
+Optional argument is the XYZ white point, which defaults to D65. */)
+  (Lisp_Object color1, Lisp_Object color2)
+{
+  cmsViewingConditions vc;
+  cmsJCh jch1, jch2;
+  cmsHANDLE h1, h2;
+  cmsCIEXYZ xyz1, xyz2;
+  double Jp1, ap1, bp1, Jp2, ap2, bp2;
+  double Mp1, Mp2, FL, k;
+
+  if (!(CONSP (color1) && parse_xyz_list (color1, &xyz1)))
+    signal_error ("Invalid color", color1);
+  if (!(CONSP (color2) && parse_xyz_list (color2, &xyz2)))
+    signal_error ("Invalid color", color1);
+
+  vc.whitePoint.X = 95.047;
+  vc.whitePoint.Y = 100.00;
+  vc.whitePoint.Z = 108.883;
+  vc.Yb = 20;
+  vc.La = 100;
+  vc.surround = AVG_SURROUND;
+  vc.D_value = 1.0;
+
+  h1 = cmsCIECAM02Init(0, &vc);
+  h2 = cmsCIECAM02Init(0, &vc);
+  cmsCIECAM02Forward(h1, &xyz1, &jch1);
+  cmsCIECAM02Forward(h2, &xyz2, &jch2);
+  cmsCIECAM02Done(h1);
+  cmsCIECAM02Done(h2);
+  /* Now have JCh, need to calculate Jab
+
+     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.0f / (1.0f + (5.0f * vc.La));
+  FL = pow(k, 4) * vc.La +
+    0.1f * pow(1 - pow(k, 4), 2) * pow(5.0f * vc.La, 1.0f / 3.0f);
+  Mp1 = 43.86f * log(1.0f + 0.0228f * (jch1.C * pow(FL, 0.25)));
+  Mp2 = 43.86f * log(1.0f + 0.0228f * (jch2.C * pow(FL, 0.25)));
+  Jp1 = 1.7f * jch1.J / (1.0f + (0.007f * jch1.J));
+  Jp2 = 1.7f * jch2.J / (1.0f + (0.007f * jch2.J));
+  ap1 = Mp1 * cos(jch1.h);
+  ap2 = Mp2 * cos(jch2.h);
+  bp1 = Mp1 * sin(jch1.h);
+  bp2 = Mp2 * sin(jch2.h);
+  return make_float(sqrt(pow(Jp2 - Jp1, 2) +
+                         pow(ap2 - ap1, 2) +
+                         pow(bp2 - bp1, 2)));
+}
+
+
+/* Initialization */
+void
+syms_of_lcms2 (void)
+{
+  defsubr (&Slcms_cie_de2000);
+  defsubr (&Slcms_cam02_ucs);
+}
+
+#endif /* HAVE_LCMS2 */
diff --git a/src/lisp.h b/src/lisp.h
index 81f8d6a24b..19594e7830 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4396,6 +4396,11 @@ extern void syms_of_xml (void);
 extern void xml_cleanup_parser (void);
 #endif
 
+#ifdef HAVE_LCMS2
+/* Defined in lcms.c.  */
+extern void syms_of_lcms2 (void);
+#endif
+
 #ifdef HAVE_ZLIB
 /* Defined in decompress.c.  */
 extern void syms_of_decompress (void);

Message #26 received at 28400 <at> debbugs.gnu.org (full text, mbox):

From: Eli Zaretskii <eliz <at> gnu.org>
To: Mark Oteiza <mvoteiza <at> udel.edu>
Cc: 28400 <at> debbugs.gnu.org
Subject: Re: bug#28400: 26.0.50; lcms2 bindings
Date: Tue, 12 Sep 2017 18:53:00 +0300

> Date: Mon, 11 Sep 2017 19:10:06 -0400
> From: Mark Oteiza <mvoteiza <at> udel.edu>
> Cc: 28400 <at> debbugs.gnu.org
> 
> > Oh, I see.  But in that case, I think adding a new file and the
> > configure.ac business is actually quite easy.
> 
> Humble beginnings attached.

Thanks, it looks good.  A few comments:

> diff --git a/src/lcms.c b/src/lcms.c
> new file mode 100644
> index 0000000000..560b262818
> --- /dev/null
> +++ b/src/lcms.c
> @@ -0,0 +1,157 @@
> +/* Interface to Little CMS
> +   Copyright (C) 2017 Mark Oteiza <mvoteiza <at> udel.edu>
> +
> +This file is NOT part of GNU Emacs.

This will have to change to our standard preamble, of course.

> +DEFUN ("lcms-cie-de2000", Flcms_cie_de2000, Slcms_cie_de2000, 2, 2, 0,
> +       doc: /* Compute CIEDE2000 metric distance between COLOR1 and COLOR2.
> +Each color is a list of L*a*b* coordinates, where the L* channel ranges from
> +0 to 100, and the a* and b* channels range from -128 to 128.
> +Optional arguments KL, KC, KH are weighting parameters for lightness,
> +chroma, and hue, respectively. */)
> +  (Lisp_Object color1, Lisp_Object color2)

I don't see any optional arguments.

> +DEFUN ("lcms-cam02-ucs", Flcms-cam02-ucs, Slcms_cam02_ucs, 2, 2, 0,
> +       doc: /* Compute CAM02-UCS metric distance between COLOR1 and COLOR2.
> +Each color is a list of XYZ coordinates.
> +Optional argument is the XYZ white point, which defaults to D65. */)
> +  (Lisp_Object color1, Lisp_Object color2)

Likewise.

> +  k = 1.0f / (1.0f + (5.0f * vc.La));

Any reason why you use float constants, as opposed to double?

> +  FL = pow(k, 4) * vc.La +
> +    0.1f * pow(1 - pow(k, 4), 2) * pow(5.0f * vc.La, 1.0f / 3.0f);
> +  Mp1 = 43.86f * log(1.0f + 0.0228f * (jch1.C * pow(FL, 0.25)));
> +  Mp2 = 43.86f * log(1.0f + 0.0228f * (jch2.C * pow(FL, 0.25)));
> +  Jp1 = 1.7f * jch1.J / (1.0f + (0.007f * jch1.J));
> +  Jp2 = 1.7f * jch2.J / (1.0f + (0.007f * jch2.J));
> +  ap1 = Mp1 * cos(jch1.h);
> +  ap2 = Mp2 * cos(jch2.h);
> +  bp1 = Mp1 * sin(jch1.h);
> +  bp2 = Mp2 * sin(jch2.h);
> +  return make_float(sqrt(pow(Jp2 - Jp1, 2) +
> +                         pow(ap2 - ap1, 2) +
> +                         pow(bp2 - bp1, 2)));

I generally dislike 'pow', where simpler functions will do.  'pow' is
expensive and less accurate numerically than the alternatives (where
they exist); it also makes the code slightly harder to read and
understand.  Granted, this code is unlikely to run in the inner-most
loops of some Lisp program, or to require last-ulp accuracy, so some
of these arguments are admittedly weak.  But still...

So I'd replace:

   pow (SOMETHING, 2)             with SOMETHING*SOMETHING
   pow (SOMETHING, 1./3.)         with cubrt (SOMETHING)
   pow (k, 4)                     with k * k * k * k
   pow (FL, 0.25)                 with sqrt (sqrt (FL))

etc.

Also, a nit: we leave a blank between the function name and the
following left paren.

I think this will also need a NEWS entry, under "Installation
Changes".

Thanks again for working on this.

Message #29 received at 28400 <at> debbugs.gnu.org (full text, mbox):

From: Mark Oteiza <mvoteiza <at> udel.edu>
To: Eli Zaretskii <eliz <at> gnu.org>
Cc: 28400 <at> debbugs.gnu.org
Subject: Re: bug#28400: 26.0.50; lcms2 bindings
Date: Tue, 12 Sep 2017 17:06:58 -0400

On 12/09/17 at 06:53pm, Eli Zaretskii wrote:
> > Date: Mon, 11 Sep 2017 19:10:06 -0400
> > From: Mark Oteiza <mvoteiza <at> udel.edu>
> > Cc: 28400 <at> debbugs.gnu.org
> >
> > +  k = 1.0f / (1.0f + (5.0f * vc.La));
> 
> Any reason why you use float constants, as opposed to double?

Mistake, thanks.

> > +  FL = pow(k, 4) * vc.La +
> > +    0.1f * pow(1 - pow(k, 4), 2) * pow(5.0f * vc.La, 1.0f / 3.0f);
> > +  Mp1 = 43.86f * log(1.0f + 0.0228f * (jch1.C * pow(FL, 0.25)));
> > +  Mp2 = 43.86f * log(1.0f + 0.0228f * (jch2.C * pow(FL, 0.25)));
> > +  Jp1 = 1.7f * jch1.J / (1.0f + (0.007f * jch1.J));
> > +  Jp2 = 1.7f * jch2.J / (1.0f + (0.007f * jch2.J));
> > +  ap1 = Mp1 * cos(jch1.h);
> > +  ap2 = Mp2 * cos(jch2.h);
> > +  bp1 = Mp1 * sin(jch1.h);
> > +  bp2 = Mp2 * sin(jch2.h);
> > +  return make_float(sqrt(pow(Jp2 - Jp1, 2) +
> > +                         pow(ap2 - ap1, 2) +
> > +                         pow(bp2 - bp1, 2)));
> 
> <snip>
> 
> So I'd replace:
> 
>    pow (SOMETHING, 2)             with SOMETHING*SOMETHING
>    pow (SOMETHING, 1./3.)         with cubrt (SOMETHING)
>    pow (k, 4)                     with k * k * k * k
>    pow (FL, 0.25)                 with sqrt (sqrt (FL))
> 
> etc.
> 
> Also, a nit: we leave a blank between the function name and the
> following left paren.
> 
> I think this will also need a NEWS entry, under "Installation
> Changes".

Thanks for all the comments, I've implemented them all, I think.

 configure.ac    |  19 ++++++
 etc/NEWS        |   5 ++
 src/Makefile.in |   6 +-
 src/emacs.c     |   4 ++
 src/lcms.c      | 180 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 src/lisp.h      |   5 ++
 src/xfaces.c    |  15 +++--
 7 files changed, 227 insertions(+), 7 deletions(-)

diff --git a/configure.ac b/configure.ac
index d294412dc4..df3931f938 100644
--- a/configure.ac
+++ b/configure.ac
@@ -3451,6 +3451,25 @@ AC_DEFUN
 fi
 AC_SUBST(LIBJPEG)
 
+HAVE_LCMS2=no
+LIBLCMS2=
+if test "${with_lcms2}" != "no"; then
+  OLIBS=$LIBS
+  AC_SEARCH_LIBS([cmsCreateTransform], [lcms2], [HAVE_LCMS2=yes])
+  LIBS=$OLIBS
+  case $ac_cv_search_cmsCreateTransform in
+    -*) LIBLCMS2=$ac_cv_search_cmsCreateTransform ;;
+  esac
+fi
+if test "${HAVE_LCMS2}" = "yes"; then
+  AC_DEFINE([HAVE_LCMS2], 1, [Define to 1 if you have the lcms2 library (-llcms2).])
+  ### ???
+  if test "${opsys}" = "mingw32"; then
+     LIBLCMS2=
+  fi
+fi
+AC_SUBST(LIBLCMS2)
+
 HAVE_ZLIB=no
 LIBZ=
 if test "${with_zlib}" != "no"; then
diff --git a/etc/NEWS b/etc/NEWS
index 03ef05b2a3..e97fb612a0 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -69,6 +69,11 @@ Deterministic builds omit the build date from the output of the
 following variables nil: 'emacs-build-system', 'emacs-build-time',
 'erc-emacs-build-time'.
 
+** New configure option '--with-lcms2' attempts to build an Emacs
+linked to Little CMS, exposing color management functions in Lisp.
+Implemented functions include the color metrics 'lcms-cie-de2000' and
+'lcms-cam02-ucs'.
+
 ** The configure option '--with-gameuser' now defaults to 'no',
 as this appears to be the most common configuration in practice.
 When it is 'no', the shared game directory and the auxiliary program
diff --git a/src/Makefile.in b/src/Makefile.in
index dde3f1d3fb..a98ad9c5eb 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -234,6 +234,8 @@ LIBXML2_CFLAGS =
 
 GETADDRINFO_A_LIBS = @GETADDRINFO_A_LIBS@
 
+LIBLCMS2 = @LIBLCMS2@
+
 LIBZ = @LIBZ@
 
 ## system-specific libs for dynamic modules, else empty
@@ -389,7 +391,7 @@ base_obj =
 	syntax.o $(UNEXEC_OBJ) bytecode.o \
 	process.o gnutls.o callproc.o \
 	region-cache.o sound.o atimer.o \
-	doprnt.o intervals.o textprop.o composite.o xml.o $(NOTIFY_OBJ) \
+	doprnt.o intervals.o textprop.o composite.o xml.o lcms.o $(NOTIFY_OBJ) \
 	$(XWIDGETS_OBJ) \
 	profiler.o decompress.o \
 	thread.o systhread.o \
@@ -490,7 +492,7 @@ LIBES =
    $(LIBXML2_LIBS) $(LIBGPM) $(LIBS_SYSTEM) $(CAIRO_LIBS) \
    $(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(SETTINGS_LIBS) $(LIBSELINUX_LIBS) \
    $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \
-   $(LIBGNUTLS_LIBS) $(LIB_PTHREAD) $(GETADDRINFO_A_LIBS) \
+   $(LIBGNUTLS_LIBS) $(LIB_PTHREAD) $(GETADDRINFO_A_LIBS) $(LIBLCMS2) \
    $(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) $(LIBSYSTEMD_LIBS)
 
 ## FORCE it so that admin/unidata can decide whether these files
diff --git a/src/emacs.c b/src/emacs.c
index 44f6285795..668711a5ab 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -1546,6 +1546,10 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
       syms_of_xml ();
 #endif
 
+#ifdef HAVE_LCMS2
+      syms_of_lcms2 ();
+#endif
+
 #ifdef HAVE_ZLIB
       syms_of_decompress ();
 #endif
diff --git a/src/lcms.c b/src/lcms.c
new file mode 100644
index 0000000000..076073d5c7
--- /dev/null
+++ b/src/lcms.c
@@ -0,0 +1,180 @@
+/* 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 <http://www.gnu.org/licenses/>.  */
+
+#include <config.h>
+
+#ifdef HAVE_LCMS2
+
+#include <lcms2.h>
+#include <math.h>
+
+#include "lisp.h"
+
+static bool
+parse_lab_list (Lisp_Object lab_list, cmsCIELab *color)
+{
+#define PARSE_LAB_LIST_FIELD(field)					\
+  if (CONSP (lab_list) && NUMBERP (XCAR (lab_list)))			\
+    {									\
+      color->field = XFLOATINT (XCAR (lab_list));			\
+      lab_list = XCDR (lab_list);					\
+    }									\
+  else									\
+    return false;
+
+  PARSE_LAB_LIST_FIELD (L);
+  PARSE_LAB_LIST_FIELD (a);
+  PARSE_LAB_LIST_FIELD (b);
+
+  return true;
+}
+
+/* http://www.ece.rochester.edu/~gsharma/ciede2000/ciede2000noteCRNA.pdf> */
+
+DEFUN ("lcms-cie-de2000", Flcms_cie_de2000, Slcms_cie_de2000, 2, 5, 0,
+       doc: /* Compute CIEDE2000 metric distance between COLOR1 and COLOR2.
+Each color is a list of L*a*b* coordinates, where the L* channel ranges from
+0 to 100, and the a* and b* channels range from -128 to 128.
+Optional arguments KL, KC, KH are weighting parameters for lightness,
+chroma, and hue, respectively. The parameters each default to 1. */)
+  (Lisp_Object color1, Lisp_Object color2,
+   Lisp_Object kL, Lisp_Object kC, Lisp_Object kH)
+{
+  cmsCIELab Lab1, Lab2;
+  cmsFloat64Number Kl, Kc, Kh;
+
+  if (!(CONSP (color1) && parse_lab_list (color1, &Lab1)))
+    signal_error ("Invalid color", color1);
+  if (!(CONSP (color2) && parse_lab_list (color2, &Lab2)))
+    signal_error ("Invalid color", color1);
+  if (NILP (kL))
+    Kl = 1.0f;
+  else if (!(NUMBERP (kL) && (Kl = XFLOATINT(kL))))
+    wrong_type_argument(Qnumberp, kL);
+  if (NILP (kC))
+    Kc = 1.0f;
+  else if (!(NUMBERP (kC) && (Kc = XFLOATINT(kC))))
+    wrong_type_argument(Qnumberp, kC);
+  if (NILP (kL))
+    Kh = 1.0f;
+  else if (!(NUMBERP (kH) && (Kh = XFLOATINT(kH))))
+    wrong_type_argument(Qnumberp, kH);
+
+  return make_float (cmsCIE2000DeltaE (&Lab1, &Lab2, Kl, Kc, Kh));
+}
+
+/* FIXME: code duplication */
+
+static bool
+parse_xyz_list (Lisp_Object xyz_list, cmsCIEXYZ *color)
+{
+#define PARSE_XYZ_LIST_FIELD(field)					\
+  if (CONSP (xyz_list) && NUMBERP (XCAR (xyz_list)))			\
+    {									\
+      color->field = 100.0 * XFLOATINT (XCAR (xyz_list));		\
+      xyz_list = XCDR (xyz_list);					\
+    }									\
+  else									\
+    return false;
+
+  PARSE_XYZ_LIST_FIELD (X);
+  PARSE_XYZ_LIST_FIELD (Y);
+  PARSE_XYZ_LIST_FIELD (Z);
+
+  return true;
+}
+
+DEFUN ("lcms-cam02-ucs", Flcms_cam02_ucs, Slcms_cam02_ucs, 2, 3, 0,
+       doc: /* Compute CAM02-UCS metric distance between COLOR1 and COLOR2.
+Each color is a list of XYZ coordinates, with Y scaled to unity.
+Optional argument is the XYZ white point, which defaults to illuminant D65. */)
+  (Lisp_Object color1, Lisp_Object color2, Lisp_Object whitepoint)
+{
+  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;
+
+  if (!(CONSP (color1) && parse_xyz_list (color1, &xyz1)))
+    signal_error ("Invalid color", color1);
+  if (!(CONSP (color2) && parse_xyz_list (color2, &xyz2)))
+    signal_error ("Invalid color", color1);
+  if (NILP (whitepoint))
+    {
+      xyzw.X = 95.047;
+      xyzw.Y = 100.0;
+      xyzw.Z = 108.883;
+    }
+  else if (!(CONSP (whitepoint) && parse_xyz_list(whitepoint, &xyzw)))
+    signal_error("Invalid white point", whitepoint);
+
+  vc.whitePoint.X = xyzw.X;
+  vc.whitePoint.Y = xyzw.Y;
+  vc.whitePoint.Z = xyzw.Z;
+  vc.Yb = 20;
+  vc.La = 100;
+  vc.surround = AVG_SURROUND;
+  vc.D_value = 1.0;
+
+  h1 = cmsCIECAM02Init (0, &vc);
+  h2 = cmsCIECAM02Init (0, &vc);
+  cmsCIECAM02Forward (h1, &xyz1, &jch1);
+  cmsCIECAM02Forward (h2, &xyz2, &jch2);
+  cmsCIECAM02Done (h1);
+  cmsCIECAM02Done (h2);
+  /* 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 (jch1.h);
+  ap2 = Mp2 * cos (jch2.h);
+  bp1 = Mp1 * sin (jch1.h);
+  bp2 = Mp2 * sin (jch2.h);
+  return make_float (sqrt ((Jp2 - Jp1) * (Jp2 - Jp1) +
+                           (ap2 - ap1) * (ap2 - ap1) +
+                           (bp2 - bp1) * (bp2 - bp1)));
+}
+
+
+/* Initialization */
+void
+syms_of_lcms2 (void)
+{
+  defsubr (&Slcms_cie_de2000);
+  defsubr (&Slcms_cam02_ucs);
+}
+
+#endif /* HAVE_LCMS2 */
diff --git a/src/lisp.h b/src/lisp.h
index 81f8d6a24b..19594e7830 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4396,6 +4396,11 @@ extern void syms_of_xml (void);
 extern void xml_cleanup_parser (void);
 #endif
 
+#ifdef HAVE_LCMS2
+/* Defined in lcms.c.  */
+extern void syms_of_lcms2 (void);
+#endif
+
 #ifdef HAVE_ZLIB
 /* Defined in decompress.c.  */
 extern void syms_of_decompress (void);
diff --git a/src/xfaces.c b/src/xfaces.c
index 86bb9b0b49..32a5bd5f60 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -4088,12 +4088,14 @@ color_distance (XColor *x, XColor *y)
 }
 
 
-DEFUN ("color-distance", Fcolor_distance, Scolor_distance, 2, 3, 0,
+DEFUN ("color-distance", Fcolor_distance, Scolor_distance, 2, 4, 0,
        doc: /* Return an integer distance between COLOR1 and COLOR2 on FRAME.
 COLOR1 and COLOR2 may be either strings containing the color name,
-or lists of the form (RED GREEN BLUE).
-If FRAME is unspecified or nil, the current frame is used.  */)
-  (Lisp_Object color1, Lisp_Object color2, Lisp_Object frame)
+or lists of the form (RED GREEN BLUE), each in the range 0 to 65535 inclusive.
+If FRAME is unspecified or nil, the current frame is used.
+If METRIC is unspecified or nil, a modified L*u*v* metric is used.  */)
+  (Lisp_Object color1, Lisp_Object color2, Lisp_Object frame,
+   Lisp_Object metric)
 {
   struct frame *f = decode_live_frame (frame);
   XColor cdef1, cdef2;
@@ -4107,7 +4109,10 @@ If FRAME is unspecified or nil, the current frame is used.  */)
 	   && defined_color (f, SSDATA (color2), &cdef2, false)))
     signal_error ("Invalid color", color2);
 
-  return make_number (color_distance (&cdef1, &cdef2));
+  if (NILP (metric))
+    return make_number (color_distance (&cdef1, &cdef2));
+  else
+    return call2 (metric, color1, color2);
 }
 
 

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.