(require 'munsell-data)

(defun munsell-lookup (color)
  (cdr (assoc color munsell-color-alist)))

(put 'munsell-split 'lisp-indent-function 2)
(defmacro munsell-split (color-expr vars body &optional invalid-action)
  (let ((color-var (make-symbol "_color"))
	(hue-var (nth 0 vars))
	(value-var (nth 1 vars))
	(chroma-var (nth 2 vars)))
    `(let ((,color-var ,color-expr))
       (if (string-match "^\\(N\\([0-9]+\\(\\.[0-9]*\\)?\\)\\|\\([0-9]+\\(\\.[0-9]*\\)?\\)\\(B\\|BG\\|G\\|GY\\|Y\\|YR\\|R\\|RP\\|P\\|PB\\)\\([0-9]+\\(\\.[0-9]*\\)?\\)/\\([0-9]+\\(\\.[0-9]*\\)?\\)\\)$" ,color-var)
	   (let ((,hue-var
		  (if (match-beginning 2)
		      '(0 . "N")
		    (cons (string-to-number (match-string 4 ,color-var))
			  (match-string 6 ,color-var))))
		 (,value-var
		  (string-to-number
		   (match-string (if (match-beginning 2) 2 7) ,color-var)))
		 (,chroma-var
		  (if (match-beginning 2)
		      0
		    (string-to-number (match-string 9 ,color-var)))))
	     ,body)
	 ,(or
	   invalid-action
	   `(error "invalid munsell color: %s" ,color-var))))))

(defun munsell-hue-round (h &optional round-function)
  (unless round-function (setq round-function 'round))
  (let ((h2 (* 5 (apply round-function (car h) '(2.5)))))
    (if (= h2 0)
	(concat
	 "10" 
	 (cadr
	  (member
	   (cdr h) '("R" "RP" "P" "PB" "B" "BG" "G" "GY" "Y" "YR" "R"))))
      (concat
       (int-to-string (ash h2 -1))
       (unless (= (logand h2 1) 0) ".5")
       (cdr h)))))

(defun munsell-value-round (v &optional round-function)
  (unless round-function (setq round-function 'round))
  (if (<= v 0.9)
      (let ((rounded (apply round-function v '(0.2))))
	(if (= rounded 5)
	    "1"
	  (concat "0." (int-to-string (* 2 rounded)))))
    (int-to-string (apply round-function v '(1)))))

(defun munsell-chroma-round (c &optional round-function)
  (unless round-function (setq round-function 'round))
  (int-to-string (* 2 (apply chroma-round c '(2)))))

(defun munsell-round (h v c hue-round value-round chroma-round)
  (let ((c-rounded (munsell-chroma-round c chroma-round))
	(v-rounded (munsell-value-round v value-round)))
    (if (string= c-rounded "0")
	(concat "N" v-rounded)
      (concat (munsell-hue-round h hue-round) v-rounded "/" c-rounded))))

(defun munsell-convert (color)
  (munsell-split color (h v c)
    (munsell-lookup (munsell-round h v c 'round 'round 'round))))

(provide 'munsell-conv)