Add lcms2 interface
configure.ac: Add boilerplate for configuring and detecting liblcms2. etc/NEWS: Mention new configure option and color-distance change. src/Makefile.in: Add references to lcms.c and liblcms. src/emacs.c: Define lcms2 symbols. src/lcms.c: New file. src/lisp.h: Add declaration for lcms2. src/xfaces.c: Add optional METRIC argument.
This commit is contained in:
parent
9a8bbb9d5d
commit
5d4c539bd7
7 changed files with 234 additions and 7 deletions
19
configure.ac
19
configure.ac
|
@ -3451,6 +3451,25 @@ if test "${with_jpeg}" != "no"; then
|
|||
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
|
||||
|
|
10
etc/NEWS
10
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
|
||||
|
@ -1588,6 +1593,11 @@ function keeps on returning the line number taking potential narrowing
|
|||
into account. If this parameter is non-nil, the function ignores
|
||||
narrowing and returns the absolute line number.
|
||||
|
||||
---
|
||||
** The function 'color-distance' now takes a second optional argument
|
||||
'metric'. When non-nil, it should be a function of two arguments that
|
||||
accepts two colors and returns a number.
|
||||
|
||||
** Changes in Frame and Window Handling
|
||||
|
||||
+++
|
||||
|
|
|
@ -234,6 +234,8 @@ LIBXML2_CFLAGS = @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 = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \
|
|||
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 = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(LIBX_BASE) $(LIBIMAGE) \
|
|||
$(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
|
||||
|
|
|
@ -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
|
||||
|
|
182
src/lcms.c
Normal file
182
src/lcms.c
Normal file
|
@ -0,0 +1,182 @@
|
|||
/* 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 */
|
|
@ -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);
|
||||
|
|
15
src/xfaces.c
15
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);
|
||||
}
|
||||
|
||||
|
||||
|
|
Loading…
Add table
Reference in a new issue