diff options
| -rw-r--r-- | src/lcms.c | 18 | ||||
| -rw-r--r-- | test/src/lcms-tests.el | 19 |
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 | ||
| 163 | DEFUN ("lcms-cam02-ucs", Flcms_cam02_ucs, Slcms_cam02_ucs, 2, 3, 0, | 163 | DEFUN ("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. |
| 165 | Each color is a list of XYZ coordinates, with Y scaled to unity. | 165 | Each color is a list of XYZ coordinates, with Y scaled about unity. |
| 166 | Optional argument is the XYZ white point, which defaults to illuminant D65. */) | 166 | Optional 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, | |||
| 295 | void | 291 | void |
| 296 | syms_of_lcms2 (void) | 292 | syms_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. |
| 38 | B is considered the exact value." | 41 | B 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)) |