bug#28400: 26.0.50; lcms2 bindings

[Mark Oteiza <mvoteiza@udel.edu>]

[-- Attachment #1: Type: text/plain, Size: 738 bytes --]


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.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: lcms2.patch --]
[-- Type: text/x-diff, Size: 7233 bytes --]

diff --git a/configure.ac b/configure.ac
index 5aaf006c54..e85c1e4d97 100644
--- a/configure.ac
+++ b/configure.ac
@@ -3151,7 +3151,7 @@ AC_DEFUN
 	OLD_LIBS="$LIBS"
 	CPPFLAGS="$CPPFLAGS $XFT_CFLAGS"
 	CFLAGS="$CFLAGS $XFT_CFLAGS"
-	XFT_LIBS="-lXrender $XFT_LIBS"
+	XFT_LIBS="-lXrender $XFT_LIBS -llcms2"
 	LIBS="$XFT_LIBS $LIBS"
 	AC_CHECK_HEADER(X11/Xft/Xft.h,
 	  AC_CHECK_LIB(Xft, XftFontOpen, HAVE_XFT=yes, , $XFT_LIBS) , ,
diff --git a/src/xfaces.c b/src/xfaces.c
index accb98bf4c..604404aafd 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -205,6 +205,8 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include <sys/types.h>
 #include <sys/stat.h>
 
+#include <lcms2.h>
+
 #include "lisp.h"
 #include "character.h"
 #include "frame.h"
@@ -352,7 +354,7 @@ static struct face_cache *make_face_cache (struct frame *);
 static void free_face_cache (struct face_cache *);
 static bool merge_face_ref (struct frame *, Lisp_Object, Lisp_Object *,
 			    bool, struct named_merge_point *);
-static int color_distance (XColor *x, XColor *y);
+static double color_distance (XColor *x, XColor *y);
 
 #ifdef HAVE_WINDOW_SYSTEM
 static void set_font_frame_param (Lisp_Object, Lisp_Object);
@@ -4063,35 +4065,41 @@ prepare_face_for_display (struct frame *f, struct face *face)
 
 /* Returns the `distance' between the colors X and Y.  */
 
-static int
+static double
 color_distance (XColor *x, XColor *y)
 {
-  /* This formula is from a paper titled `Colour metric' by Thiadmer Riemersma.
-     Quoting from that paper:
-
-	 This formula has results that are very close to L*u*v* (with the
-	 modified lightness curve) and, more importantly, it is a more even
-	 algorithm: it does not have a range of colors where it suddenly
-	 gives far from optimal results.
-
-     See <http://www.compuphase.com/cmetric.htm> for more info.  */
-
-  long r = (x->red   - y->red)   >> 8;
-  long g = (x->green - y->green) >> 8;
-  long b = (x->blue  - y->blue)  >> 8;
-  long r_mean = (x->red + y->red) >> 9;
-
-  return
-    (((512 + r_mean) * r * r) >> 8)
-    + 4 * g * g
-    + (((767 - r_mean) * b * b) >> 8);
+  /* http://www.ece.rochester.edu/~gsharma/ciede2000/ciede2000noteCRNA.pdf> */
+  cmsHPROFILE profile_in, profile_out;
+  cmsHTRANSFORM transform;
+  cmsCIELab Labx, Laby;
+  cmsUInt16Number rgbx[3], rgby[3];
+  cmsFloat64Number delta;
+
+  profile_in = cmsCreate_sRGBProfile();
+  profile_out = cmsCreateLab4Profile(NULL);
+  transform = cmsCreateTransform(profile_in, TYPE_RGB_16,
+                                 profile_out, TYPE_Lab_DBL,
+                                 INTENT_PERCEPTUAL, 0);
+  cmsCloseProfile(profile_in);
+  cmsCloseProfile(profile_out);
+  rgbx[0] = x->red;
+  rgbx[1] = x->green;
+  rgbx[2] = x->blue;
+  rgby[0] = y->red;
+  rgby[1] = y->green;
+  rgby[2] = y->blue;
+  cmsDoTransform(transform, rgbx, &Labx, 1);
+  cmsDoTransform(transform, rgby, &Laby, 1);
+  cmsDeleteTransform(transform);
+  delta = cmsCIE2000DeltaE(&Labx, &Laby, 1.0, 1.0, 1.0);
+  return delta;
 }
 
 
 DEFUN ("color-distance", Fcolor_distance, Scolor_distance, 2, 3, 0,
-       doc: /* Return an integer distance between COLOR1 and COLOR2 on FRAME.
+       doc: /* Return a float 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).
+or lists of the form (RED GREEN BLUE), in the range 0 to 65355 inclusive.
 If FRAME is unspecified or nil, the current frame is used.  */)
   (Lisp_Object color1, Lisp_Object color2, Lisp_Object frame)
 {
@@ -4107,7 +4115,7 @@ 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));
+  return make_float (color_distance (&cdef1, &cdef2));
 }
 
 \f
@@ -4627,9 +4635,9 @@ DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector,
 
 /* If the distance (as returned by color_distance) between two colors is
    less than this, then they are considered the same, for determining
-   whether a color is supported or not.  The range of values is 0-65535.  */
+   whether a color is supported or not.  The range of values is 0-100.  */
 
-#define TTY_SAME_COLOR_THRESHOLD  10000
+#define TTY_SAME_COLOR_THRESHOLD  2.3
 
 #ifdef HAVE_WINDOW_SYSTEM
 
@@ -4897,7 +4905,7 @@ tty_supports_face_attributes_p (struct frame *f,
      distance between the standard foreground and background.  */
   if (STRINGP (fg) && STRINGP (bg))
     {
-      int delta_delta
+      double delta_delta
 	= (color_distance (&fg_std_color, &bg_std_color)
 	   - color_distance (&fg_tty_color, &bg_tty_color));
       if (delta_delta > TTY_SAME_COLOR_THRESHOLD
diff --git a/src/xterm.c b/src/xterm.c
index bdc21e6de0..8cb203d418 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -27,6 +27,8 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include <math.h>
 #endif
 
+#include <lcms2.h>
+
 #include "lisp.h"
 #include "blockinput.h"
 
@@ -2372,18 +2374,37 @@ x_alloc_nearest_color_1 (Display *dpy, Colormap cmap, XColor *color)
 	 a least-squares matching, which is what X uses for closest
 	 color matching with StaticColor visuals.  */
       int nearest, i;
-      int max_color_delta = 255;
-      int max_delta = 3 * max_color_delta;
-      int nearest_delta = max_delta + 1;
+      cmsFloat64Number max_color_delta = 100.0f;
+      cmsFloat64Number max_delta = 3 * max_color_delta;
+      cmsFloat64Number nearest_delta = max_delta + 1;
       int ncells;
       const XColor *cells = x_color_cells (dpy, &ncells);
-
+      cmsHPROFILE profile_in, profile_out;
+      cmsHTRANSFORM transform;
+      cmsCIELab Lab;
+      cmsUInt16Number rgb[3];
+
+      profile_in = cmsCreate_sRGBProfile();
+      profile_out = cmsCreateLab4Profile(NULL);
+      transform = cmsCreateTransform(profile_in, TYPE_RGB_16,
+                                     profile_out, TYPE_Lab_DBL,
+                                     INTENT_PERCEPTUAL, 0);
+      cmsCloseProfile(profile_in);
+      cmsCloseProfile(profile_out);
+      rgb[0] = color->red;
+      rgb[1] = color->green;
+      rgb[2] = color->blue;
+      cmsDoTransform(transform, rgb, &Lab, 1);
       for (nearest = i = 0; i < ncells; ++i)
 	{
-	  int dred   = (color->red   >> 8) - (cells[i].red   >> 8);
-	  int dgreen = (color->green >> 8) - (cells[i].green >> 8);
-	  int dblue  = (color->blue  >> 8) - (cells[i].blue  >> 8);
-	  int delta = dred * dred + dgreen * dgreen + dblue * dblue;
+          cmsCIELab Labi;
+          cmsUInt16Number rgbi[3];
+
+          rgbi[0] = cells[i].red;
+          rgbi[1] = cells[i].green;
+          rgbi[2] = cells[i].blue;
+          cmsDoTransform(transform, rgbi, &Labi, 1);
+          cmsFloat64Number delta = cmsCIE2000DeltaE(&Lab, &Labi, 1.0f, 1.0f, 1.0f);
 
 	  if (delta < nearest_delta)
 	    {
@@ -2391,7 +2412,7 @@ x_alloc_nearest_color_1 (Display *dpy, Colormap cmap, XColor *color)
 	      nearest_delta = delta;
 	    }
 	}
-
+      cmsDeleteTransform(transform);
       color->red   = cells[nearest].red;
       color->green = cells[nearest].green;
       color->blue  = cells[nearest].blue;

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: module --]
[-- Type: text/x-csrc, Size: 5291 bytes --]

/*
  Copyright (C) 2016 Mark Oteiza <mvoteiza@udel.edu>

  Author: Mark Oteiza <mvoteiza@udel.edu>
  Created: 01 March 2016

  This library is free software; you can redistribute it and/or
  modify it under the terms of the GNU Lesser General Public
  License version 2 as published by the Free Software Foundation.

  This library 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
  Lesser General Public License for more details.

  You should have received a copy of the GNU Lesser General Public
  License along with this library. If not, see
  <http://www.gnu.org/licenses/>.
*/

#include <stdio.h>
#include <stdlib.h>
#include <math.h>

#include <X11/Xlib.h>
#include <lcms2.h>

#include "emacs-module.h"

#define UNUSED __attribute__((unused))

int plugin_is_GPL_compatible;

static emacs_value Flcms2_ciede2000 (emacs_env *env, ptrdiff_t UNUSED argc,
                                     emacs_value argv[], void UNUSED *data) {
    emacs_value ret;
    double L1 = env->extract_float(env, argv[0]);
    double a1 = env->extract_float(env, argv[1]);
    double b1 = env->extract_float(env, argv[2]);
    double L2 = env->extract_float(env, argv[3]);
    double a2 = env->extract_float(env, argv[4]);
    double b2 = env->extract_float(env, argv[5]);
    double kL = env->extract_float(env, argv[6]);
    double kC = env->extract_float(env, argv[7]);
    double kH = env->extract_float(env, argv[8]);

    const cmsCIELab lab1 = { .L = L1, .a = a1, .b = b1 };
    const cmsCIELab lab2 = { .L = L2, .a = a2, .b = b2 };
    ret = env->make_float(env, cmsCIE2000DeltaE (&lab1, &lab2, kL, kC, kH));
    return ret;
}

static emacs_value Flcms2_ciecamde02 (emacs_env *env, ptrdiff_t UNUSED argc,
                                      emacs_value argv[], void UNUSED *data) {
    emacs_value ret;
    cmsViewingConditions vc;
    cmsJCh jch1, jch2;
    cmsHANDLE h1, h2;
    /* scale XYZ because emacs funs expect these correlates to be in
       the unit line segment [0,1] */
    double X1 = 100 * env->extract_float(env, argv[0]);
    double Y1 = 100 * env->extract_float(env, argv[1]);
    double Z1 = 100 * env->extract_float(env, argv[2]);
    double X2 = 100 * env->extract_float(env, argv[3]);
    double Y2 = 100 * env->extract_float(env, argv[4]);
    double Z2 = 100 * env->extract_float(env, argv[5]);
    /* printf("(%f, %f, %f) <-> (%f, %f, %f)\n", X1, Y1, Z1, X2, Y2, Z2); */
    double Mp1, Mp2, FL, k;
    double Jp1, ap1, bp1, Jp2, ap2, bp2;
    /* UCS coefficients */
    /* double KL = 0.77; */
    /* double c1 = 0.007; */
    /* double c2 = 0.0228; */

    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);
    const cmsCIEXYZ xyz1 = { .X = X1, .Y = Y1, .Z = Z1 };
    const cmsCIEXYZ xyz2 = { .X = X2, .Y = Y2, .Z = Z2 };

    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.0 / (1.0 + (5.0 * vc.La));
    FL = pow(k, 4) * vc.La + 0.1 * pow(1 - pow(k, 4), 2) * pow(5 * vc.La, 1.0 / 3.0);
    Mp1 = 43.86 * log(1.0 + 0.0228 * (jch1.C * pow(FL, 0.25)));
    Mp2 = 43.86 * log(1.0 + 0.0228 * (jch2.C * pow(FL, 0.25)));
    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);
    ret = env->make_float(env, sqrt(pow(Jp2 - Jp1, 2.0) +
                                    pow(ap2 - ap1, 2.0) +
                                    pow(bp2 - bp1, 2.0)));
    return ret;
}

static void bind_function(emacs_env *env, const char *name, emacs_value Sfun) {
    emacs_value Qfset = env->intern(env, "fset");
    emacs_value Qsym = env->intern(env, name);
    emacs_value args[] = { Qsym, Sfun };

    env->funcall(env, Qfset, 2, args);
}

static void provide(emacs_env *env, const char *feature) {
    emacs_value Qfeat = env->intern(env, feature);
    emacs_value Qprovide = env->intern (env, "provide");
    emacs_value args[] = { Qfeat };

    env->funcall(env, Qprovide, 1, args);
}

int emacs_module_init(struct emacs_runtime *ert) {
    emacs_env *env = ert->get_environment(ert);

    bind_function(env, "lcms2-ciede2000-internal",
                  env->make_function(env, 9, 9, Flcms2_ciede2000,
                                     "Compute CIEDE2000 between two colors.\
\n(fn L1 A1 B1 L2 A2 B2 kL kC kH)", NULL));
    bind_function(env, "lcms2-ciecamde02-internal",
                  env->make_function(env, 6, 6, Flcms2_ciecamde02,
                                     "Compute CIECAM02 between two colors.\
\n(fn X1 Y1 Z1 X2 Y2 Z2)", NULL));
    provide(env, "lcms2");
    return EXIT_SUCCESS;
}