test/src/lcms-tests.el

   1 ;;; lcms-tests.el --- tests for Little CMS interface -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2017-2018 Free Software Foundation, Inc.
   4
   5 ;; Maintainer: emacs-devel@gnu.org
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software: you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23
  24 ;; Some reference values computed using the colorspacious python
  25 ;; library, assimilated from its test suite, or adopted from its
  26 ;; aggregation of gold values.
  27 ;; See https://colorspacious.readthedocs.io/en/v1.1.0/ and
  28 ;; https://github.com/njsmith/colorspacious
  29
  30 ;; Other references:
  31 ;; http://www.babelcolor.com/index_htm_files/A%20review%20of%20RGB%20color%20spaces.pdf
  32
  33 ;;; Code:
  34
  35 (require 'ert)
  36 (require 'color)
  37
  38 (defconst lcms-colorspacious-d65 '(0.95047 1.0 1.08883)
  39   "D65 white point from colorspacious.")
  40
  41 (defun lcms-approx-p (a b &optional delta)
  42   "Check if A and B are within relative error DELTA of one another.
  43 B is considered the exact value."
  44   (> (or delta 0.001) (abs (1- (/ a b)))))
  45
  46 (defun lcms-triple-approx-p (a b &optional delta)
  47   "Like `lcms-approx-p' except for color triples."
  48   (pcase-let ((`(,a1 ,a2 ,a3) a)
  49               (`(,b1 ,b2 ,b3) b))
  50    (and (lcms-approx-p a1 b1 delta)
  51         (lcms-approx-p a2 b2 delta)
  52         (lcms-approx-p a3 b3 delta))))
  53
  54 (defun lcms-rgb255->xyz (rgb)
  55   "Return XYZ tristimulus values corresponding to RGB."
  56   (let ((rgb1 (mapcar (lambda (x) (/ x 255.0)) rgb)))
  57     (apply #'color-srgb-to-xyz rgb1)))
  58
  59 (ert-deftest lcms-cri-cam02-ucs ()
  60   "Test use of `lcms-cam02-ucs'."
  61   (skip-unless (featurep 'lcms2))
  62   (should-error (lcms-cam02-ucs '(0 0 0) '(0 0 0) "error"))
  63   (should-error (lcms-cam02-ucs '(0 0 0) 'error))
  64   (should-not
  65    (lcms-approx-p
  66     (let ((wp '(0.44757 1.0 0.40745)))
  67       (lcms-cam02-ucs '(0.5 0.5 0.5) '(0 0 0) wp))
  68     (lcms-cam02-ucs '(0.5 0.5 0.5) '(0 0 0))))
  69   (should (eql 0.0 (lcms-cam02-ucs '(0.5 0.5 0.5) '(0.5 0.5 0.5))))
  70   (should
  71    (lcms-approx-p (lcms-cam02-ucs lcms-colorspacious-d65
  72                                   '(0 0 0)
  73                                   lcms-colorspacious-d65)
  74                   100.0)))
  75
  76 (ert-deftest lcms-whitepoint ()
  77   "Test use of `lcms-temp->white-point'."
  78   (skip-unless (featurep 'lcms2))
  79   (should-error (lcms-temp->white-point 3999))
  80   (should-error (lcms-temp->white-point 25001))
  81   ;; D55
  82   (should
  83    (lcms-triple-approx-p
  84     (apply #'color-xyz-to-xyy (lcms-temp->white-point 5503))
  85     '(0.33242 0.34743 1.0)))
  86   ;; D65
  87   (should
  88    (lcms-triple-approx-p
  89     (apply #'color-xyz-to-xyy (lcms-temp->white-point 6504))
  90     '(0.31271 0.32902 1.0)))
  91   ;; D75
  92   (should
  93    (lcms-triple-approx-p
  94     (apply #'color-xyz-to-xyy (lcms-temp->white-point 7504))
  95     '(0.29902 0.31485 1.0))))
  96
  97 (ert-deftest lcms-roundtrip ()
  98   "Test accuracy of converting to and from different color spaces"
  99   (skip-unless (featurep 'lcms2))
 100   (should
 101    (let ((color '(.5 .3 .7)))
 102      (lcms-triple-approx-p (lcms-jch->xyz (lcms-xyz->jch color))
 103                            color
 104                            0.0001)))
 105   (should
 106    (let ((color '(.8 -.2 .2)))
 107      (lcms-triple-approx-p (lcms-jch->jab (lcms-jab->jch color))
 108                            color
 109                            0.0001))))
 110
 111 (ert-deftest lcms-ciecam02-gold ()
 112   "Test CIE CAM02 JCh gold values"
 113   (skip-unless (featurep 'lcms2))
 114   (should
 115    (lcms-triple-approx-p
 116     (lcms-xyz->jch '(0.1931 0.2393 0.1014)
 117                    '(0.9888 0.900 0.3203)
 118                    '(18 200 1 1.0))
 119     '(48.0314 38.7789 191.0452)
 120     0.02))
 121   (should
 122    (lcms-triple-approx-p
 123     (lcms-xyz->jch '(0.1931 0.2393 0.1014)
 124                    '(0.9888 0.90 0.3203)
 125                    '(18 20 1 1.0))
 126     '(47.6856 36.0527 185.3445)
 127     0.09)))
 128
 129 (ert-deftest lcms-dE-cam02-ucs-silver ()
 130   "Test CRI-CAM02-UCS deltaE metric values from colorspacious."
 131   (skip-unless (featurep 'lcms2))
 132   (should
 133    (lcms-approx-p
 134     (lcms-cam02-ucs (lcms-rgb255->xyz '(173 52 52))
 135                     (lcms-rgb255->xyz '(59 120 51))
 136                     lcms-colorspacious-d65
 137                     (list 20 (/ 64 float-pi 5) 1 1))
 138     44.698469808449964
 139     0.03))
 140   (should
 141    (lcms-approx-p
 142     (lcms-cam02-ucs (lcms-rgb255->xyz '(69 100 52))
 143                     (lcms-rgb255->xyz '(59 120 51))
 144                     lcms-colorspacious-d65
 145                     (list 20 (/ 64 float-pi 5) 1 1))
 146     8.503323264883667
 147     0.04)))
 148
 149 (ert-deftest lcms-jmh->cam02-ucs-silver ()
 150   "Compare JCh conversion to CAM02-UCS to values from colorspacious."
 151   (skip-unless (featurep 'lcms2))
 152   (should
 153    (lcms-triple-approx-p (lcms-jch->jab '(50 20 10))
 154                          '(62.96296296 16.22742674 2.86133316)
 155                          0.05))
 156   (should
 157    (lcms-triple-approx-p (lcms-jch->jab '(10 60 100))
 158                          '(15.88785047 -6.56546789 37.23461867)
 159                          0.04)))
 160
 161 ;;; lcms-tests.el ends here