From: akr Date: Thu, 26 Oct 2000 15:36:27 +0000 (+0000) Subject: munsell-conv.el, munsell.el: combine hue-minor and hue-major. X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=1c1d8dad006c1df3a375e74f7c3e500516704583;p=elisp%2Fmunsell.git munsell-conv.el, munsell.el: combine hue-minor and hue-major. --- diff --git a/munsell-conv.el b/munsell-conv.el index b2818cf..29b3a08 100644 --- a/munsell-conv.el +++ b/munsell-conv.el @@ -8,14 +8,12 @@ (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)) + (let ((,hue-var (cons (string-to-number (match-string 1 ,color-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)))) ,body) @@ -23,13 +21,13 @@ invalid-action `(error "invalid munsell color: %s" ,color-var)))))) -(defun munsell-round (h-minor h-major v c hue-round value-round chroma-round) +(defun munsell-round (h v c hue-round value-round chroma-round) (concat - (let ((h2 (* 5 (apply hue-round h-minor '(2.5))))) + (let ((h2 (* 5 (apply hue-round (car h) '(2.5))))) (if (= (logand h2 1) 0) (int-to-string (ash h2 -1)) (concat (int-to-string (ash h2 -1)) ".5"))) - h-major + (cdr h) (if (< v 0.9) (concat "0." (int-to-string (* 2 (apply value-round v '(0.2))))) (int-to-string (apply value-round v '(1)))) @@ -37,7 +35,7 @@ (int-to-string (* 2 (apply chroma-round c '(2)))))) (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) diff --git a/munsell.el b/munsell.el index 6ac5e49..8df9ab1 100644 --- a/munsell.el +++ b/munsell.el @@ -2,8 +2,8 @@ (require 'munsell-names) (defun munsell-resolv-color (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)) (let ((p (assoc color munsell-named-color-alist))) (if p (cdr p)