initial version.

diff --git a/Makefile b/Makefile
new file mode 100644 (file)
index 0000000..ee990d8
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,6 @@
+munsell-data.el: all.dat 
+       awk 'NR != 1 {printf("(\"%s%s/%s\" . \"CIExyY:%s/%s/%s\")\n", $$1, $$2, $$3, $$4, $$5, $$6 / 100)}' all.dat > _generated
+       m4 munsell-data.template > munsell-data.el
+
+all.dat:
+       wget -N ftp://ftp.cis.rit.edu/mcsl/munsell_data/all.dat

diff --git a/munsell-conv.el b/munsell-conv.el
new file mode 100644 (file)
index 0000000..b2818cf
--- /dev/null
+++ b/munsell-conv.el
@@ -0,0 +1,43 @@
+;; -*- coding: iso-2022-7bit; -*-
+
+(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-minor-var (nth 0 vars))
+       (hue-major-var (nth 1 vars))
+       (value-var (nth 2 vars))
+       (chroma-var (nth 3 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))))
+            ,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-convert (color)
+  (munsell-split color (h-minor h-major v c)
+    (munsell-lookup (munsell-round h-minor h-major v c 'round 'round 'round))))
+
+(provide 'munsell-conv)

diff --git a/munsell-data.template b/munsell-data.template
new file mode 100644 (file)
index 0000000..dbf1aa9
--- /dev/null
+++ b/munsell-data.template
@@ -0,0 +1,5 @@
+(defconst munsell-color-alist
+  '(include(_generated))
+  "Munsell Renotation Data")
+
+(provide 'munsell-data)

diff --git a/munsell-names.el b/munsell-names.el
new file mode 100644 (file)
index 0000000..5577c1d
--- /dev/null
+++ b/munsell-names.el
@@ -0,0 +1,102 @@
+;; -*- coding: iso-2022-7bit; -*-
+
+(require 'munsell-conv)
+
+(defconst munsell-color-names-alist
+  '(("2.5R3.0/3.0" "\e$BAIK'\e(B" "\e$B$9$[$&\e(B")
+    ("2.5R7.0/8.0" "\e$B9HG_\e(B" "\e$B$3$&$P$$\e(B")
+    ("4.0R4.0/14.0" "\e$B4Z9H2V\e(B" "\e$B$+$i$/$l$J$p\e(B")
+    ("2.5R6.0/10.0" "\e$BEm2V\e(B" "\e$B$b$b\e(B")
+    ("2.5R7.0/7.0" "\e$B:y\e(B" "\e$B$5$/$i\e(B")
+    ("2.5YR8.0/4.0" "\e$BFy\e(B" "\e$B$K$/\e(B")
+    ("7.5R4.0/14.0" "\e$B@VAIK'\e(B" "\e$B$"$+$9$[$&\e(B")
+    ("5.0R4.5/13.0" "\e$B6d<k\e(B" "\e$B$.$s$7$e\e(B")
+    ("7.5R4.5/14.0" "\e$B`O!9Hl\e(B" "\e$B$7$g$&$8$g$&$R\e(B")
+    ("7.5R5.0/13.0" "\e$B9HHl\e(B" "\e$B$Y$K$R\e(B")
+    ("10R5.5/14.0" "\e$B2+C0\e(B" "\e$B$o$&$?$s\e(B")
+    ("10R6.0/11.0" "\e$B??Hl\e(B" "\e$B$^$R\e(B")
+    ("2.5YR7.0/11.0" "\e$(DT`\e(B" "\e$B$=$R\e(B")
+    ("10R6.5/10.0" "\e$B3A\e(B" "\e$B$+$-\e(B")
+    ("10YR7.5/8.0" "\e$B?<;Y;R\e(B" "\e$B$3$-$/$A$J$7\e(B")
+    ("7.5YR7.0/11.0" "\e$B4;;R\e(B" "\e$B$3$&$8\e(B")
+    ("10YR7.5/10.0" "\e$B5`MU\e(B" "\e$B$/$A$P\e(B")
+    ("5.0YR8.0/6.0" "\e$B@VGrFK\e(B" "\e$B$"$+$7$m$D$k$P$_\e(B")
+    ("2.5R3.5/5.0" "\e$B>.F&\e(B" "\e$B$"$:$-\e(B")
+    ("5.0R4.0/11.0" "\e$BIrF:Cc\e(B" "\e$B$($S$A$c\e(B")
+    ("2.5R4.5/10.0" "\e$B??<k\e(B" "\e$B$7$s$7$e\e(B")
+    ("2.0YR3.5/4.0" "\e$B[XHi\e(B" "\e$B$R$O$@\e(B")
+    ("7.5R4.0/7.0" "\e$B%Y%s%,%i\e(B" "\e$B$Y$s$,$i\e(B")
+    ("10R4.5/8.0" "\e$BBel`\e(B" "\e$B$?$$$7$c\e(B")
+    ("10R3.0/2.0" "\e$B>GCc\e(B" "\e$B$3$2$A$c\e(B")
+    ("10R3.0/4.0" "\e$B7*Hi\e(B" "\e$B$/$j$+$O\e(B")
+    ("10R4.0/7.0" "\e$BFP\e(B" "\e$B$H$S\e(B")
+    ("10R4.0/5.0" "\e$B3w\e(B" "\e$B$+$P\e(B")
+    ("2.5Y5.0/4.0" "\e$B2+H'@w\e(B" "\e$B$3$&$m$;$s\e(B")
+    ("5.0YR4.0/4.0" "\e$BCz;RCc\e(B" "\e$B$A$g$&$8$A$c\e(B")
+    ("10YR4.0/4.0" "\e$B<F\e(B" "\e$B$U$7\e(B")
+    ("7.5YR6.0/6.0" "\e$BCz;z\e(B" "\e$B$A$g$&$8\e(B")
+    ("7.5YR5.5/6.0" "\e$BDS2+\e(B" "\e$B$7$c$*$&\e(B")
+    ("10YR6.0/7.0" "\e$B%+!<%-!<\e(B" "\e$B$+!<$-!<\e(B")
+    ("7.5YR6.0/5.0" "\e$B7,\e(B" "\e$B$/$o\e(B")
+    ("2.5Y6.5/7.0" "\e$B2+FK\e(B" "\e$B$-$D$k$P$_\e(B")
+    ("10YR7.5/6.0" "\e$B9a\e(B" "\e$B$3$&\e(B")
+    ("10YR7.0/7.0" "\e$B2+EZ\e(B" "\e$B$*$&$I\e(B")
+    ("3.5Y8.0/12.0" "\e$B;3?a\e(B" "\e$B$d$^$V$-\e(B")
+    ("3.0Y8.0/14.0" "\e$BF#2+\e(B" "\e$B$H$&$*$&\e(B")
+    ("4.5Y8.0/12.0" "\e$B]56b\e(B" "\e$B$&$3$s\e(B")
+    ("5.0Y8.0/10.0" "\e$B4"0B\e(B" "\e$B$+$j$d$9\e(B")
+    ("4.5Y8.0/8.0" "\e$B2+\e(B[\e$Bi-\e(B/\e$BLZ\e(B]" "\e$B$-$O$@\e(B")
+    ("3.0Y8.0/7.0" "\e$B;Y;R\e(B" "\e$B$/$A$J$7\e(B")
+    ("4.0Y8.0/8.0" "\e$B6L;R\e(B" "\e$B$?$^$4\e(B")
+    ("10Y8.0/10.0" "\e$Bs4\e(B" "\e$B$R$o\e(B")
+    ("5.0GY7.0/8.0" "\e$Bs4K(2+\e(B" "\e$B$R$o$b$($.\e(B")
+    ("7.5GY5.5/5.0" "\e$Brt\e(B" "\e$B$&$0$$$9\e(B")
+    ("10GY5.5/9.0" "\e$BK(2+\e(B" "\e$B$b$($.\e(B")
+    ("10GY4.0/6.0" "\e$BNP\e(B" "\e$B$_$I$j\e(B")
+    ("5.0G6.0/8.0" "\e$BNP@D\e(B" "\e$B$m$/$7$g$&\e(B")
+    ("2.5G8.0/2.0" "\e$BGrNP\e(B" "\e$B$S$c$/$m$/\e(B")
+    ("7.5G5.0/5.0" "\e$B>>MU\e(B" "\e$B$^$D$P\e(B")
+    ("5.0BG4.0/4.0" "\e$B;3Mu@"\e(B" "\e$B$d$^$"$$$:$j\e(B")
+    ("2.5GY3.5/2.0" "\e$B3$>>\e(B" "\e$B$_$k\e(B")
+    ("10Y4.0/2.0" "\e$BU;Cc\e(B" "\e$B$3$S$A$c\e(B")
+    ("5.0GY7.5/3.0" "\e$B@DGrFK\e(B" "\e$B$"$*$7$m$D$k$P$_\e(B")
+    ("7.5PB2.3/3.0" "\e$B2X;R:0\e(B" "\e$B$J$9$3$s\e(B")
+    ("7.5PB3.0/3.0" "\e$B:0\e(B" "\e$B$3$s\e(B")
+    ("5.0PB3.0/4.0" "\e$BG<8M\e(B" "\e$B$J$s$I\e(B")
+    ("8.5PB3.0/12.0" "\e$B:0@D\e(B" "\e$B$3$s$8$g$&\e(B")
+    ("7.5PB3.0/12.0" "\e$BN0M~\e(B" "\e$B$k$j\e(B")
+    ("6.0PB3.5/12.0" "\e$B72@D\e(B" "\e$B$0$s$8$g$&\e(B")
+    ("7.5B6.0/4.0" "\e$BGr72\e(B" "\e$B$S$c$/$0$s\e(B")
+    ("10B3.5/5.0" "\e$Be]\e(B" "\e$B$O$J$@\e(B")
+    ("10BG6.0/3.0" "\e$B@u2+\e(B" "\e$B$"$5$.\e(B")
+    ("5.0P2.5/4.0" "\e$BLG;g\e(B" "\e$B$a$C$7\e(B")
+    ("5.0P2.5/4.0" "\e$B?<;g\e(B" "\e$B$3$`$i$5$-\e(B")
+    ("5.0P4.0/3.0" "\e$BFsMu\e(B" "\e$B$U$?$"$$\e(B")
+    ("7.5P3.5/4.0" "\e$B;g\e(B" "\e$B$`$i$5$-\e(B")
+    ("7.5P3.5/6.0" "\e$BIrF:\e(B" "\e$B$($S\e(B")
+    ("8.5R4.5/4.0" "\e$B?<Hl\e(B" "\e$B$3$-$R\e(B")
+    ("10PB3.5/10" "\e$B5K9<\e(B" "\e$B$-$-$g$&\e(B")
+    ("7.5P5.0/8.0" "\e$BF#\e(B" "\e$B$U$8\e(B")
+    ("5.0RP4.5/14" "\e$B24C0\e(B" "\e$B$\$?$s\e(B")
+;;    ("N1.5/0" "\e$BKO\e(B" "\e$B$9$_\e(B")
+;;    ("5.0YR3.0/0.5" "\e$BKOFK\e(B" "\e$B$/$m$D$k$P$_\e(B")
+;;    ("2.5YR3.0/0.5" "\e$Bb%\e(B" "\e$B$/$j\e(B")
+;;    ("7.5R4.0/0.5" "\e$BF_\e(B" "\e$B$K$S\e(B")
+;;    ("5.0B4.0/0.5" "\e$B@DF_\e(B" "\e$B$"$*$K$S\e(B")
+;;    ("5.0G4.5/0.5" "\e$BMx5WAM\e(B" "\e$B$j$-$e$&$M$:$_\e(B")
+;;    ("5.0GY5.0/0.5" "\e$B3%\e(B" "\e$B$O$$\e(B")
+    )
+  "Munsell color names")
+
+(defconst munsell-named-color-alist
+  (apply
+   'append
+   (mapcar
+    (lambda (p)
+      (let ((color (munsell-convert (car p)))
+           (names (cdr p)))
+       (mapcar (lambda (name) (cons name color)) names)))
+    munsell-color-names-alist))
+  "Munsell named colors")
+
+(provide 'munsell-names)

diff --git a/munsell.el b/munsell.el
new file mode 100644 (file)
index 0000000..6ac5e49
--- /dev/null
+++ b/munsell.el
@@ -0,0 +1,29 @@
+(require 'munsell-conv)
+(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))
+    (let ((p (assoc color munsell-named-color-alist)))
+      (if p
+         (cdr p)
+       color))))
+
+(defadvice modify-frame-parameters (before resolv-color activate)
+  (ad-set-arg
+   1
+   (mapcar
+    (lambda (p)
+      (if (memq (car p)
+                '(background-color
+                  foreground-color
+                  cursor-color
+                  mouse-color
+                  border-color))
+          (cons
+           (car p)
+           (munsell-resolv-color (cdr p)))
+        p))
+           (ad-get-arg 1))))
+
+(provide 'munsell)
\ No newline at end of file