all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
blob d6d1d16b9ada47aa2e1fd350335c88bd6d66b54e 3970 bytes (raw)
name: test/src/lcms-tests.el 	 # note: path name is non-authoritative(*)

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
 
;;; lcms-tests.el --- tests for Little CMS interface -*- lexical-binding: t -*-

;; Copyright (C) 2017 Free Software Foundation, Inc.

;; Maintainer: emacs-devel@gnu.org

;; 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 <https://www.gnu.org/licenses/>.

;;; Commentary:

;; Some reference values computed using the colorspacious python
;; library, assimilated from its test suite, or adopted from its
;; aggregation of gold values.
;; See https://colorspacious.readthedocs.io/en/v1.1.0/ and
;; https://github.com/njsmith/colorspacious

;; Other references:
;; http://www.babelcolor.com/index_htm_files/A%20review%20of%20RGB%20color%20spaces.pdf

;;; Code:

(require 'ert)
(require 'color)

(defconst lcms-colorspacious-d65 '(0.95047 1.0 1.08883)
  "D65 white point from colorspacious.")

(defun lcms-approx-p (a b &optional delta)
  "Check if A and B are within relative error DELTA of one another.
B is considered the exact value."
  (> (or delta 0.001) (abs (1- (/ a b)))))

(defun lcms-triple-approx-p (a b &optional delta)
  "Like `lcms-approx-p' except for color triples."
  (pcase-let ((`(,a1 ,a2 ,a3) a)
              (`(,b1 ,b2 ,b3) b))
   (and (lcms-approx-p a1 b1 delta)
        (lcms-approx-p a2 b2 delta)
        (lcms-approx-p a3 b3 delta))))

(defun lcms-rgb255->xyz (rgb)
  "Return XYZ tristimulus values corresponding to RGB."
  (let ((rgb1 (mapcar (lambda (x) (/ x 255.0)) rgb)))
    (apply #'color-srgb-to-xyz rgb1)))

(ert-deftest lcms-cri-cam02-ucs ()
  "Test use of `lcms-cam02-ucs'."
  (skip-unless (featurep 'lcms2))
  (should-error (lcms-cam02-ucs '(0 0 0) '(0 0 0) "error"))
  (should-error (lcms-cam02-ucs '(0 0 0) 'error))
  (should-not
   (lcms-approx-p
    (let ((wp '(0.44757 1.0 0.40745)))
      (lcms-cam02-ucs '(0.5 0.5 0.5) '(0 0 0) wp))
    (lcms-cam02-ucs '(0.5 0.5 0.5) '(0 0 0))))
  (should (eql 0.0 (lcms-cam02-ucs '(0.5 0.5 0.5) '(0.5 0.5 0.5))))
  (should
   (lcms-approx-p (lcms-cam02-ucs lcms-colorspacious-d65
                                  '(0 0 0)
                                  lcms-colorspacious-d65)
                  100.0)))

(ert-deftest lcms-whitepoint ()
  "Test use of `lcms-temp->white-point'."
  (skip-unless (featurep 'lcms2))
  (should-error (lcms-temp->white-point 3999))
  (should-error (lcms-temp->white-point 25001))
  ;; D55
  (should
   (lcms-triple-approx-p
    (apply #'color-xyz-to-xyy (lcms-temp->white-point 5503))
    '(0.33242 0.34743 1.0)))
  ;; D65
  (should
   (lcms-triple-approx-p
    (apply #'color-xyz-to-xyy (lcms-temp->white-point 6504))
    '(0.31271 0.32902 1.0)))
  ;; D75
  (should
   (lcms-triple-approx-p
    (apply #'color-xyz-to-xyy (lcms-temp->white-point 7504))
    '(0.29902 0.31485 1.0))))

(ert-deftest lcms-dE-cam02-ucs-silver ()
  "Test CRI-CAM02-UCS deltaE metric values from colorspacious."
  (skip-unless (featurep 'lcms2))
  (should
   (lcms-approx-p
    (lcms-cam02-ucs (lcms-rgb255->xyz '(173 52 52))
                    (lcms-rgb255->xyz '(59 120 51))
                    lcms-colorspacious-d65
                    (list 20 (/ 64 float-pi 5) 1 1))
    44.698469808449964
    0.03))
  (should
   (lcms-approx-p
    (lcms-cam02-ucs (lcms-rgb255->xyz '(69 100 52))
                    (lcms-rgb255->xyz '(59 120 51))
                    lcms-colorspacious-d65
                    (list 20 (/ 64 float-pi 5) 1 1))
    8.503323264883667
    0.04)))

;;; lcms-tests.el ends here

debug log:

solving d6d1d16b9a ...
found d6d1d16b9a in https://git.savannah.gnu.org/cgit/emacs.git

(*) Git path names are given by the tree(s) the blob belongs to.
    Blobs themselves have no identifier aside from the hash of its contents.^

Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.