-;; -*- coding: iso-2022-7bit; -*-
-
(require 'munsell-data)
(defun munsell-lookup (color)
(put 'munsell-split 'lisp-indent-function 2)
(defmacro munsell-split (color-expr vars body &optional invalid-action)
(let ((color-var (make-symbol "_color"))
- (hue-minor-var (nth 0 vars))
- (hue-major-var (nth 1 vars))
- (value-var (nth 2 vars))
- (chroma-var (nth 3 vars)))
+ (hue-var (nth 0 vars))
+ (value-var (nth 1 vars))
+ (chroma-var (nth 2 vars)))
`(let ((,color-var ,color-expr))
- (if (string-match "^\\([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-minor-var (string-to-number (match-string 1 ,color-var)))
- (,hue-major-var (match-string 3 ,color-var))
- (,value-var (string-to-number (match-string 4 ,color-var)))
- (,chroma-var (string-to-number (match-string 6 ,color-var))))
+ (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-round (h-minor h-major v c hue-round value-round chroma-round)
- (concat
- (let ((h2 (* 5 (apply hue-round h-minor '(2.5)))))
- (if (= (logand h2 1) 0)
- (int-to-string (ash h2 -1))
- (concat (int-to-string (ash h2 -1)) ".5")))
- h-major
- (if (< v 0.9)
- (concat "0." (int-to-string (* 2 (apply value-round v '(0.2)))))
- (int-to-string (apply value-round v '(1))))
- "/"
- (int-to-string (* 2 (apply chroma-round c '(2))))))
+(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-minor h-major v c)
- (munsell-lookup (munsell-round h-minor h-major v c 'round 'round 'round))))
+ (munsell-split color (h v c)
+ (munsell-lookup (munsell-round h v c 'round 'round 'round))))
(provide 'munsell-conv)