1 (require 'munsell-data)
3 (defun munsell-lookup (color)
4 (cdr (assoc color munsell-color-alist)))
6 (put 'munsell-split 'lisp-indent-function 2)
7 (defmacro munsell-split (color-expr vars body &optional invalid-action)
8 (let ((color-var (make-symbol "_color"))
10 (value-var (nth 1 vars))
11 (chroma-var (nth 2 vars)))
12 `(let ((,color-var ,color-expr))
13 (if (string-match "^\\(N\\|\\([0-9]+\\(\\.[0-9]*\\)?\\)\\(B\\|BG\\|G\\|GY\\|Y\\|YR\\|R\\|RP\\|P\\|PB\\)\\)\\([0-9]+\\(\\.[0-9]*\\)?\\)/\\([0-9]+\\(\\.[0-9]*\\)?\\)$" ,color-var)
15 (if (match-beginning 2)
16 (cons (string-to-number (match-string 2 ,color-var))
17 (match-string 4 ,color-var))
18 (cons 0 (match-string 1 ,color-var))))
19 (,value-var (string-to-number (match-string 5 ,color-var)))
20 (,chroma-var (string-to-number (match-string 7 ,color-var))))
24 `(error "invalid munsell color: %s" ,color-var))))))
26 (defun munsell-round (h v c hue-round value-round chroma-round)
28 (let ((h2 (* 5 (apply hue-round (car h) '(2.5)))))
29 (if (= (logand h2 1) 0)
30 (int-to-string (ash h2 -1))
31 (concat (int-to-string (ash h2 -1)) ".5")))
34 (concat "0." (int-to-string (* 2 (apply value-round v '(0.2)))))
35 (int-to-string (apply value-round v '(1))))
37 (int-to-string (* 2 (apply chroma-round c '(2))))))
39 (defun munsell-convert (color)
40 (munsell-split color (h v c)
41 (munsell-lookup (munsell-round h v c 'round 'round 'round))))
43 (provide 'munsell-conv)