aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--src/lcms.c18
-rw-r--r--test/src/lcms-tests.el19
2 files changed, 29 insertions, 8 deletions
diff --git a/src/lcms.c b/src/lcms.c
index 1f3ace3baac..cdfbc0ecf99 100644
--- a/src/lcms.c
+++ b/src/lcms.c
@@ -162,7 +162,7 @@ parse_xyz_list (Lisp_Object xyz_list, cmsCIEXYZ *color)
162 162
163DEFUN ("lcms-cam02-ucs", Flcms_cam02_ucs, Slcms_cam02_ucs, 2, 3, 0, 163DEFUN ("lcms-cam02-ucs", Flcms_cam02_ucs, Slcms_cam02_ucs, 2, 3, 0,
164 doc: /* Compute CAM02-UCS metric distance between COLOR1 and COLOR2. 164 doc: /* Compute CAM02-UCS metric distance between COLOR1 and COLOR2.
165Each color is a list of XYZ coordinates, with Y scaled to unity. 165Each color is a list of XYZ coordinates, with Y scaled about unity.
166Optional argument is the XYZ white point, which defaults to illuminant D65. */) 166Optional argument is the XYZ white point, which defaults to illuminant D65. */)
167 (Lisp_Object color1, Lisp_Object color2, Lisp_Object whitepoint) 167 (Lisp_Object color1, Lisp_Object color2, Lisp_Object whitepoint)
168{ 168{
@@ -186,15 +186,11 @@ Optional argument is the XYZ white point, which defaults to illuminant D65. */)
186 if (!(CONSP (color1) && parse_xyz_list (color1, &xyz1))) 186 if (!(CONSP (color1) && parse_xyz_list (color1, &xyz1)))
187 signal_error ("Invalid color", color1); 187 signal_error ("Invalid color", color1);
188 if (!(CONSP (color2) && parse_xyz_list (color2, &xyz2))) 188 if (!(CONSP (color2) && parse_xyz_list (color2, &xyz2)))
189 signal_error ("Invalid color", color1); 189 signal_error ("Invalid color", color2);
190 if (NILP (whitepoint)) 190 if (NILP (whitepoint))
191 { 191 parse_xyz_list (Vlcms_d65_xyz, &xyzw);
192 xyzw.X = 95.047;
193 xyzw.Y = 100.0;
194 xyzw.Z = 108.883;
195 }
196 else if (!(CONSP (whitepoint) && parse_xyz_list (whitepoint, &xyzw))) 192 else if (!(CONSP (whitepoint) && parse_xyz_list (whitepoint, &xyzw)))
197 signal_error("Invalid white point", whitepoint); 193 signal_error ("Invalid white point", whitepoint);
198 194
199 vc.whitePoint.X = xyzw.X; 195 vc.whitePoint.X = xyzw.X;
200 vc.whitePoint.Y = xyzw.Y; 196 vc.whitePoint.Y = xyzw.Y;
@@ -295,6 +291,12 @@ DEFUN ("lcms2-available-p", Flcms2_available_p, Slcms2_available_p, 0, 0, 0,
295void 291void
296syms_of_lcms2 (void) 292syms_of_lcms2 (void)
297{ 293{
294 DEFVAR_LISP ("lcms-d65-xyz", Vlcms_d65_xyz,
295 doc: /* D65 illuminant as a CIE XYZ triple. */);
296 Vlcms_d65_xyz = list3 (make_float (0.950455),
297 make_float (1.0),
298 make_float (1.088753));
299
298 defsubr (&Slcms_cie_de2000); 300 defsubr (&Slcms_cie_de2000);
299 defsubr (&Slcms_cam02_ucs); 301 defsubr (&Slcms_cam02_ucs);
300 defsubr (&Slcms2_available_p); 302 defsubr (&Slcms2_available_p);
diff --git a/test/src/lcms-tests.el b/test/src/lcms-tests.el
index 0d6b8db3d4b..e176cff2dc6 100644
--- a/test/src/lcms-tests.el
+++ b/test/src/lcms-tests.el
@@ -33,6 +33,9 @@
33(require 'ert) 33(require 'ert)
34(require 'color) 34(require 'color)
35 35
36(defconst lcms-colorspacious-d65 '(0.95047 1.0 1.08883)
37 "D65 white point from colorspacious.")
38
36(defun lcms-approx-p (a b &optional delta) 39(defun lcms-approx-p (a b &optional delta)
37 "Check if A and B are within relative error DELTA of one another. 40 "Check if A and B are within relative error DELTA of one another.
38B is considered the exact value." 41B is considered the exact value."
@@ -46,6 +49,22 @@ B is considered the exact value."
46 (lcms-approx-p a2 b2 delta) 49 (lcms-approx-p a2 b2 delta)
47 (lcms-approx-p a3 b3 delta)))) 50 (lcms-approx-p a3 b3 delta))))
48 51
52(ert-deftest lcms-cri-cam02-ucs ()
53 "Test use of `lcms-cam02-ucs'."
54 (should-error (lcms-cam02-ucs '(0 0 0) '(0 0 0) "error"))
55 (should-error (lcms-cam02-ucs '(0 0 0) 'error))
56 (should-not
57 (lcms-approx-p
58 (let ((lcms-d65-xyz '(0.44757 1.0 0.40745)))
59 (lcms-cam02-ucs '(0.5 0.5 0.5) '(0 0 0)))
60 (lcms-cam02-ucs '(0.5 0.5 0.5) '(0 0 0))))
61 (should (eql 0.0 (lcms-cam02-ucs '(0.5 0.5 0.5) '(0.5 0.5 0.5))))
62 (should
63 (lcms-approx-p (lcms-cam02-ucs lcms-colorspacious-d65
64 '(0 0 0)
65 lcms-colorspacious-d65)
66 100.0)))
67
49(ert-deftest lcms-whitepoint () 68(ert-deftest lcms-whitepoint ()
50 "Test use of `lcms-temp->white-point'." 69 "Test use of `lcms-temp->white-point'."
51 (should-error (lcms-temp->white-point 3999)) 70 (should-error (lcms-temp->white-point 3999))