From: akr <akr>
Date: Thu, 26 Oct 2000 15:18:56 +0000 (+0000)
Subject: initial version.
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=0f40042747f80f18f4afaf17bf55801eeb218573;p=elisp%2Fmunsell.git

initial version.
---

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